TKE  3.6
Advanced code editor for programmers
remote Namespace Reference

Functions

 initialize
 
 create type ?save_as?
 
 format_name value
 
 accept_child_command tbl target_parent src
 
 handle_row_moved data
 
 handle_save_entry value
 
 group_post
 
 connection_post
 
 test_connection edit_mode
 
 update_connection
 
 populate_group_menu
 
 change_group value
 
 check_name value
 
 check_server value
 
 check_username value
 
 check_port value
 
 check_dir
 
 handle_sb_select
 
 handle_sb_double_click
 
 show_sidebar_menu W x y X Y
 
 show_new_menu
 
 new_group
 
 validate_group value
 
 rename_group
 
 validate_rename_group value
 
 delete_group
 
 clear_editor_fields
 
 new_connection
 
 open_connection
 
 close_connection
 
 edit_connection
 
 delete_connection
 
 handle_dir dir
 
 handle_dir_mb_post
 
 handle_tl_select
 
 handle_tl_double_click
 
 edit_sidebar
 
 populate_sidebar
 
 get_password
 
 check_password value
 
 password_ok
 
 password_cancel
 
 handle_new_folder
 
 check_folder_name value
 
 handle_open
 
 handle_cancel
 
 set_current_directory directory update_hist
 
 connect name
 
 disconnect name
 
 disconnect_all
 
 find_fname listing fname
 
 file_exists name fname
 
 get_mtime name fname
 
 dir_contents name dirname pitems
 
 get_file name fname encode pcontents pmodtime
 
 save_file name fname encode contents pmodtime
 
 make_directory name dirname
 
 remove_directories name dirnames args
 
 rename_file name curr_fname new_fname
 
 duplicate_file name fname new_fname
 
 remove_files name fnames
 
 load_connections
 
 quick_load_connections
 
 save_connections
 
 get_share_items dir
 
 share_changed dir
 
 webdav_fname fname
 

Function Documentation

§ accept_child_command()

remote::accept_child_command   tbl target_parent src  

Definition at line 427 of file remote.tcl.

427  proc accept_child_command {tbl target_parent src} {
428 
429  if {[$tbl parentkey $src] eq "root"} {
430  return [expr {$target_parent eq "root"}]
431  } elseif {[$tbl cellcget $src,name -image] eq ""} {
432  return [expr {[$tbl parentkey $target_parent] eq "root"}]
433  } else {
434  return 0
435  }
436 
437  }

§ change_group()

remote::change_group   value  

Definition at line 658 of file remote.tcl.

658  proc change_group {value} {
659 
660  variable widgets
661 
662  # Update the group menubutton text
663  $widgets(edit_group) configure -text $value
664 
665  # If the create button is Update, potentially update the button state
666  if {[$widgets(edit_create) cget -text] eq [msgcat::mc "Update"]} {
667  if {([$widgets(edit_name) get] ne "") && \
668  ([$widgets(edit_server) get] ne "") && \
669  ([$widgets(edit_user) get] ne "") && \
670  ([$widgets(edit_passwd) get] ne "") && \
671  ([$widgets(edit_port) get] ne "")} {
672  $widgets(edit_create) configure -state normal
673  $widgets(edit_test) configure -state normal
674  } else {
675  $widgets(edit_create) configure -state disabled
676  $widgets(edit_test) configure -state disabled
677  }
678  }
679 
680  }

§ check_dir()

remote::check_dir

Definition at line 782 of file remote.tcl.

782  proc check_dir {} {
783 
784  variable widgets
785 
786  set type [$widgets(edit_type) cget -text]
787 
788  if {([$widgets(edit_name) get] ne "") && \
789  ([$widgets(edit_server) get] ne "") && \
790  ([$widgets(edit_user) get] ne "") && \
791  (([$widgets(edit_port) get] ne "") || ($type eq "WebDAV"))} {
792  $widgets(edit_create) configure -state normal
793  $widgets(edit_test) configure -state normal
794  } else {
795  $widgets(edit_create) configure -state disabled
796  $widgets(edit_test) configure -state disabled
797  }
798 
799  return 1
800 
801  }

§ check_folder_name()

remote::check_folder_name   value  

Definition at line 1578 of file remote.tcl.

1578  proc check_folder_name {value} {
1579 
1580  if {$value eq ""} {
1581  .foldwin.bf.ok configure -state disabled
1582  } else {
1583  .foldwin.bf.ok configure -state normal
1584  }
1585 
1586  return 1
1587 
1588  }

§ check_name()

remote::check_name   value  

Definition at line 684 of file remote.tcl.

684  proc check_name {value} {
685 
686  variable widgets
687 
688  set type [$widgets(edit_type) cget -text]
689 
690  if {($value ne "") && \
691  ([$widgets(edit_server) get] ne "") && \
692  ([$widgets(edit_user) get] ne "") && \
693  (([$widgets(edit_port) get] ne "") || ($type eq "WebDAV"))} {
694  $widgets(edit_create) configure -state normal
695  $widgets(edit_test) configure -state normal
696  } else {
697  $widgets(edit_create) configure -state disabled
698  $widgets(edit_test) configure -state disabled
699  }
700 
701  return 1
702 
703  }

§ check_password()

remote::check_password   value  

Definition at line 1483 of file remote.tcl.

1483  proc check_password {value} {
1484 
1485  if {$value eq ""} {
1486  .ftppass.bf.ok configure -state disabled
1487  } else {
1488  .ftppass.bf.ok configure -state normal
1489  }
1490 
1491  return 1
1492 
1493  }

§ check_port()

remote::check_port   value  

Definition at line 753 of file remote.tcl.

753  proc check_port {value} {
754 
755  variable widgets
756 
757  # If the value is not an integer, complain
758  if {($value ne "") && ![string is integer $value]} {
759  return 0
760  }
761 
762  set type [$widgets(edit_type) cget -text]
763 
764  if {([$widgets(edit_name) get] ne "") && \
765  ([$widgets(edit_server) get] ne "") && \
766  ([$widgets(edit_user) get] ne "") && \
767  (($value ne "") || ($type eq "WebDAV"))} {
768  $widgets(edit_create) configure -state normal
769  $widgets(edit_test) configure -state normal
770  } else {
771  $widgets(edit_create) configure -state disabled
772  $widgets(edit_test) configure -state disabled
773  }
774 
775  return 1
776 
777  }

§ check_server()

remote::check_server   value  

Definition at line 707 of file remote.tcl.

707  proc check_server {value} {
708 
709  variable widgets
710 
711  set type [$widgets(edit_type) cget -text]
712 
713  if {([$widgets(edit_name) get] ne "") && \
714  ($value ne "") && \
715  ([$widgets(edit_user) get] ne "") && \
716  (([$widgets(edit_port) get] ne "") || ($type eq "WebDAV"))} {
717  $widgets(edit_create) configure -state normal
718  $widgets(edit_test) configure -state normal
719  } else {
720  $widgets(edit_create) configure -state disabled
721  $widgets(edit_test) configure -state disabled
722  }
723 
724  return 1
725 
726  }

§ check_username()

remote::check_username   value  

Definition at line 730 of file remote.tcl.

730  proc check_username {value} {
731 
732  variable widgets
733 
734  set type [$widgets(edit_type) cget -text]
735 
736  if {([$widgets(edit_name) get] ne "") && \
737  ([$widgets(edit_server) get] ne "") && \
738  ($value ne "") && \
739  (([$widgets(edit_port) get] ne "") || ($type eq "WebDAV"))} {
740  $widgets(edit_create) configure -state normal
741  $widgets(edit_test) configure -state normal
742  } else {
743  $widgets(edit_create) configure -state disabled
744  $widgets(edit_test) configure -state disabled
745  }
746 
747  return 1
748 
749  }

§ clear_editor_fields()

remote::clear_editor_fields

Definition at line 1076 of file remote.tcl.

1076  proc clear_editor_fields {} {
1077 
1078  variable widgets
1079 
1080  $widgets(edit_type) configure -text "FTP"
1081  $widgets(edit_name) delete 0 end
1082  $widgets(edit_name) configure -state normal
1083  $widgets(edit_server) delete 0 end
1084  $widgets(edit_user) delete 0 end
1085  $widgets(edit_passwd) delete 0 end
1086  $widgets(edit_port) delete 0 end
1087  $widgets(edit_dir) delete 0 end
1088 
1089  }

§ close_connection()

remote::close_connection

Definition at line 1196 of file remote.tcl.

1196  proc close_connection {} {
1197 
1198  variable widgets
1199 
1200  # Get the currently selected connection
1201  set selected [$widgets(sb) curselection]
1202 
1203  # Get the group name
1204  set group_name [$widgets(sb) cellcget [$widgets(sb) parentkey $selected],name -text]
1205 
1206  # Get the connection name
1207  set conn_name [$widgets(sb) cellcget $selected,name -text]
1208 
1209  # Disconnect, if necessary
1210  sidebar::disconnect_by_name "$group_name,$conn_name"
1211  disconnect "$group_name,$conn_name"
1212 
1213  # Clear the icon
1214  $widgets(sb) cellconfigure $selected,name -image ""
1215 
1216  # Clear the table
1217  $widgets(tl) delete 0 end
1218 
1219  # Make sure that the Open/Save button is disabled
1220  $widgets(open) configure -state disabled
1221 
1222  # Disable the New Folder button
1223  $widgets(folder) configure -state disabled
1224 
1225  # Make sure that the directory widgets are disabled
1226  $widgets(dir_back) configure -state disabled -image remote_back_disabled
1227  $widgets(dir_forward) configure -state disabled -image remote_next_disabled
1228  $widgets(dir_mb) configure -text "" -state disabled
1229 
1230  }

§ connect()

remote::connect   name  

Definition at line 1719 of file remote.tcl.

1719  proc connect {name} {
1720 
1721  variable widgets
1722  variable connections
1723  variable opened
1724 
1725  if {![info exists connections($name)]} {
1726  return -code error [format "%s (%s)" [msgcat::mc "Connection does not exist"] $name]
1727  }
1728 
1729  lassign $connections($name) key type server user passwd port startdir
1730 
1731  # Get a password from the user if it is not set
1732  if {$passwd eq ""} {
1733  if {[set passwd [get_password]] eq ""} {
1734  return 0
1735  }
1736  lset connections($name) 3 $passwd
1737  if {[info exists widgets(sb)] && [winfo exists $widgets(sb)]} {
1738  $widgets(sb) cellconfigure $key,passwd -text $passwd
1739  }
1740  }
1741 
1742  # Open and initialize the connection
1743  switch $type {
1744  "FTP" -
1745  "SFTP" {
1746  if {[catch { ::FTP_OpenSession $name [expr {($type eq "FTP") ? "" : "s"}] $server:$port $user $passwd $server ""} rc]} {
1747  if {[winfo exists .ftp]} {
1748  tk_messageBox -parent .ftp -type ok -default ok -icon error \
1749  -message [format "%s $type %s $server" [msgcat::mc "Unable to connect to"] [msgcat::mc "server"]] -detail $rc
1750  } else {
1751  logger::log $rc
1752  }
1753  return 0
1754  } elseif {$startdir ne ""} {
1755  if {[catch { ::FTP_CD $name $startdir} rc]} {
1756  if {[winfo exists .ftp]} {
1757  tk_messageBox -parent .ftp -type ok -default ok -icon error \
1758  -message [format "%s $type %s $server" [msgcat::mc "Unable to connect to"] [msgcat::mc "server"]] -detail $rc
1759  } else {
1760  logger::log $rc
1761  }
1762  disconnect $name
1763  } elseif {$rc == 1} {
1764  set opened($name) 1
1765  return 1
1766  } else {
1767  return 0
1768  }
1769  } else {
1770  set opened($name) 1
1771  return 1
1772  }
1773  }
1774  "WebDAV" {
1775  if {[catch { webdav::connect $server -username $user -password $passwd} rc]} {
1776  if {[winfo exists .ftp]} {
1777  tk_messageBox -parent .ftp -type ok -default ok -icon error \
1778  -message [format "%s $type %s $server" [msgcat::mc "Unable to connect to"] [msgcat::mc "server"]] -default $rc
1779  } else {
1780  logger::log $rc
1781  }
1782  return 0
1783  } else {
1784  set opened($name) $rc
1785  return 1
1786  }
1787  }
1788  }
1789 
1790  return 0
1791 
1792  }

§ connection_post()

remote::connection_post

Definition at line 502 of file remote.tcl.

502  proc connection_post {} {
503 
504  variable widgets
505  variable opened
506 
507  # Get the currently selected item
508  set selected [$widgets(sb) curselection]
509 
510  # Get the group name
511  set group_name [$widgets(sb) cellcget [$widgets(sb) parentkey $selected],name -text]
512 
513  # Get the connection name
514  set conn_name [$widgets(sb) cellcget $selected,name -text]
515 
516  # Adjust the state of the menu items
517  if {[info exists opened($group_name,$conn_name)]} {
518  $widgets(connection) entryconfigure [msgcat::mc "Open Connection"] -state disabled
519  $widgets(connection) entryconfigure [msgcat::mc "Close Connection"] -state normal
520  $widgets(connection) entryconfigure [msgcat::mc "Edit Connection"] -state disabled
521  $widgets(connection) entryconfigure [msgcat::mc "Test Connection"] -state disabled
522  $widgets(connection) entryconfigure [msgcat::mc "Delete Connection"] -state disabled
523  } else {
524  $widgets(connection) entryconfigure [msgcat::mc "Open Connection"] -state normal
525  $widgets(connection) entryconfigure [msgcat::mc "Close Connection"] -state disabled
526  $widgets(connection) entryconfigure [msgcat::mc "Edit Connection"] -state normal
527  $widgets(connection) entryconfigure [msgcat::mc "Test Connection"] -state normal
528  $widgets(connection) entryconfigure [msgcat::mc "Delete Connection"] -state normal
529  }
530 
531  }

§ create()

remote::create   type ?save_as?  

Definition at line 107 of file remote.tcl.

107  proc create {type {save_as ""}} {
108 
109  variable widgets
110  variable current_server
111  variable current_fname
112  variable connections
113 
114  # Initialize the namespace
115  initialize
116 
117  toplevel .ftp
118  wm title .ftp [expr {($type eq "open") ? [msgcat::mc "Open Remote File"] : [msgcat::mc "Save File Remotely"]}]
119  wm transient .ftp .
120  wm geometry .ftp 600x400
121  wm withdraw .ftp
122 
123  set widgets(pw) [ttk::panedwindow .ftp.pw -orient horizontal]
124 
125  ###########
126  # SIDEBAR #
127  ###########
128 
129  $widgets(pw) add [ttk::frame .ftp.pw.lf]
130 
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 \
135  -labelactivebackground [utils::get_default_background] \
136  -labelbackground [utils::get_default_background] \
137  -labelforeground [utils::get_default_foreground] \
138  -labelactivebackground [utils::get_default_background] \
139  -labelactiveforeground [utils::get_default_foreground] \
140  -selectbackground [theme::get_value ttk_style active_color] \
141  -selectforeground [utils::get_default_foreground] \
142  -activestyle none \
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]
147 
148  # Register the scroller for theming
149  theme::register_widget .ftp.pw.lf.sf.vb misc_scrollbar
150 
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
154 
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]
159 
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
165 
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]]
168 
169  pack .ftp.pw.lf.bf.edit -side left -padx 2 -pady 2
170 
171  pack .ftp.pw.lf.sf -fill both -expand yes
172  pack .ftp.pw.lf.bf -fill x
173 
174  # Create contextual menus
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]
178 
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]
184 
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]
193 
194  ##########
195  # VIEWER #
196  ##########
197 
198  $widgets(pw) add [ttk::frame .ftp.pw.rf] -weight 1
199 
200  set widgets(viewer) [ttk::frame .ftp.pw.rf.vf]
201 
202  ttk::frame .ftp.pw.rf.vf.ff
203 
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]]] \
209  -state disabled]
210 
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
214 
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]
222 
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
225 
226  bind $widgets(tl) <<TablelistSelect>> [list remote::handle_tl_select]
227  bind [$widgets(tl) bodytag] <Double-Button-1> [list remote::handle_tl_double_click]
228 
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
235 
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]]
239 
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
242 
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]
250 
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
253 
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"]
257  }
258 
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
262  }
263  pack .ftp.pw.rf.vf.bf -fill x
264 
265  pack .ftp.pw.rf.vf -fill both -expand yes
266 
267  #####################
268  # CONNECTION EDITOR #
269  #####################
270 
271  set widgets(editor) [ttk::frame .ftp.ef]
272 
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]]
290 
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]
297 
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
316 
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 {
323  pack forget .ftp.ef
324  pack .ftp.pw -fill both -expand yes
325  }
326 
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
330 
331  pack .ftp.ef.sf -fill both -expand yes
332  pack .ftp.ef.bf -fill x
333 
334  # Pack the main panedwindow
335  pack .ftp.pw -fill both -expand yes
336 
337  # Update the UI
338  update
339 
340  # Populate sidebar
342 
343  # Set the current directory (if one exists)
344  if {$current_server ne ""} {
345  set_current_directory [lindex $connections($current_server) 1 5] 1
346  }
347 
348  # Populate the type menubutton
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)
356  }
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)
365  }
366  }
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)
373  }
374 
375  # Center the window
376  ::tk::PlaceWindow .ftp widget .
377 
378  # Display the window
379  wm deiconify .ftp
380 
381  # Figure out which widget should get focus
382  if {$current_server eq ""} {
383 
384  set focus_widget $widgets(sb)
385  $widgets(sb) selection set 0
386 
387  } else {
388 
389  # Select the current server in the sidebar
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]
393 
394  if {$type eq "open"} {
395  set focus_widget $widgets(tl)
396  } else {
397  set focus_widget $widgets(save_entry)
398  $widgets(save_entry) insert end $save_as
399  $widgets(save_entry) selection range 0 end
400  }
401 
402  }
403 
404  # Get the focus
405  ::tk::SetFocusGrab .ftp $focus_widget
406 
407  # Wait for the window to close
408  tkwait window .ftp
409 
410  # Restore the focus
411  ::tk::RestoreFocusGrab .ftp $focus_widget
412 
413  return [list $current_server $current_fname]
414 
415  }

§ delete_connection()

remote::delete_connection

Definition at line 1274 of file remote.tcl.

1274  proc delete_connection {} {
1275 
1276  variable widgets
1277 
1278  # Verify that the user wants to delete the connection
1279  if {[tk_messageBox -parent .ftp -icon question -type yesno -default no -message [msgcat::mc "Delete connection?"]] eq "no"} {
1280  return
1281  }
1282 
1283  # Get the currently selected item
1284  set selected [$widgets(sb) curselection]
1285 
1286  # Delete the connection from the table
1287  $widgets(sb) delete $selected
1288 
1289  # Save the connections information to file
1291 
1292  }

§ delete_group()

remote::delete_group

Definition at line 1054 of file remote.tcl.

1054  proc delete_group {} {
1055 
1056  variable widgets
1057 
1058  # Verify that the user wants to delete the connection
1059  if {[tk_messageBox -parent .ftp -icon question -type yesno -default no -message [msgcat::mc "Delete group?"]] eq "no"} {
1060  return
1061  }
1062 
1063  # Get the currently selected group
1064  set selected [$widgets(sb) curselection]
1065 
1066  # Delete the group from the sidebar
1067  $widgets(sb) delete $selected
1068 
1069  # Save the connection information
1071 
1072  }

§ dir_contents()

remote::dir_contents   name dirname pitems  

Definition at line 1923 of file remote.tcl.

1923  proc dir_contents {name dirname pitems} {
1924 
1925  variable connections
1926  variable opened
1927 
1928  upvar $pitems items
1929 
1930  switch [lindex $connections($name) 1] {
1931  "FTP" -
1932  "SFTP" {
1933  if {![catch { ::FTP_CD $name $dirname} rc]} {
1934  if {![catch { ::FTP_List $name 0} rc]} {
1935  foreach item $rc {
1936  set fname [file join $dirname [lrange $item 8 end]]
1937  if {[string index [file tail $fname] 0] eq "."} {
1938  continue
1939  }
1940  set dir [expr {[::FTP_IsDir $name $fname] eq $fname}]
1941  lappend items [list $fname $dir]
1942  }
1943  return 1
1944  } else {
1945  logger::log $rc
1946  }
1947  } else {
1948  logger::log $rc
1949  }
1950  }
1951  "WebDAV" {
1952  if {![catch { $opened($name) enumerate [string map {{ } {%20}} $dirname] 1} rc]} {
1953  foreach {fname status} [lrange $rc 2 end] {
1954  array set stat $status
1955  if {[string index $fname 0] eq "."} {
1956  continue
1957  }
1958  lappend items [list [file join $dirname [string map {{%20} { }} $fname]] [expr {$stat(type) eq "directory"}]]
1959  }
1960  return 1
1961  } else {
1962  logger::log $rc
1963  }
1964  }
1965  }
1966 
1967  return 0
1968 
1969  }

§ disconnect()

remote::disconnect   name  

Definition at line 1796 of file remote.tcl.

1796  proc disconnect {name} {
1797 
1798  variable connections
1799  variable opened
1800  variable dir_hist
1801  variable dir_hist_index
1802  variable current_server
1803 
1804  switch [lindex $connections($name) 1] {
1805  "FTP" -
1806  "SFTP" {
1807  if {[info exists opened($name)]} {
1808  ::FTP_CloseSession $name
1809  unset opened($name)
1810  }
1811  }
1812  "WebDAV" {
1813  if {[info exists opened($name)]} {
1814  $opened($name) close
1815  unset opened($name)
1816  }
1817  }
1818  }
1819 
1820  # Update directory history
1821  if {$name eq $current_server} {
1822  catch { unset dir_hist($current_server)}
1823  catch { unset dir_hist_index($current_server)}
1824  set current_server ""
1825  }
1826 
1827  }

§ disconnect_all()

remote::disconnect_all

Definition at line 1831 of file remote.tcl.

1831  proc disconnect_all {} {
1832 
1833  variable opened
1834 
1835  foreach name [array names opened] {
1836  disconnect $name
1837  }
1838 
1839  }

§ duplicate_file()

remote::duplicate_file   name fname new_fname  

Definition at line 2193 of file remote.tcl.

2193  proc duplicate_file {name fname new_fname} {
2194 
2195  variable connections
2196  variable contents
2197  variable opened
2198 
2199  # Duplicate the file
2200  switch [lindex $connections($name) 1] {
2201  "FTP" -
2202  "SFTP" {
2203  set local [file join $::tke_home sftp_dup.tmp]
2204  if {![catch { ::FTP_GetFile $name $fname $local 0} rc]} {
2205  if {![catch { ::FTP_PutFile $name $local $new_fname [file size $local]} rc]} {
2206  file delete -force $local
2207  return 1
2208  } else {
2209  logger::log $rc
2210  file delete -force $local
2211  }
2212  } else {
2213  logger::log $rc
2214  }
2215  }
2216  "WebDAV" {
2217  if {![catch { $opened($name) copy [webdav_fname $fname] [webdav_fname $new_fname]} rc]} {
2218  return 1
2219  } else {
2220  logger::log $rc
2221  }
2222  }
2223  }
2224 
2225  return 0
2226 
2227  }

§ edit_connection()

remote::edit_connection

Definition at line 1234 of file remote.tcl.

1234  proc edit_connection {} {
1235 
1236  variable widgets
1237 
1238  # Get the currently selected connection
1239  set selected [$widgets(sb) curselection]
1240 
1241  # Get the group name
1242  set group_name [$widgets(sb) cellcget [$widgets(sb) parentkey $selected],name -text]
1243 
1244  # Get the connection name
1245  set conn_name [$widgets(sb) cellcget $selected,name -text]
1246 
1247  # Get the settings
1248  set settings [$widgets(sb) cellcget $selected,settings -text]
1249 
1250  # Clear the editor fields
1252 
1253  # Insert field values
1254  $widgets(edit_type) configure -text [lindex $settings 0]
1255  $widgets(edit_group) configure -text $group_name
1256  $widgets(edit_name) insert end $conn_name
1257  $widgets(edit_server) insert end [lindex $settings 1]
1258  $widgets(edit_user) insert end [lindex $settings 2]
1259  $widgets(edit_passwd) insert end [lindex $settings 3]
1260  $widgets(edit_port) insert end [lindex $settings 4]
1261  $widgets(edit_dir) insert end [lindex $settings 5]
1262 
1263  # Set the create button text to Update
1264  $widgets(edit_create) configure -text [msgcat::mc "Update"] -state disabled
1265 
1266  # Make the editor pane visible
1267  pack forget $widgets(pw)
1268  pack $widgets(editor) -fill both -expand yes
1269 
1270  }

§ edit_sidebar()

remote::edit_sidebar

Definition at line 1412 of file remote.tcl.

1412  proc edit_sidebar {} {
1413 
1414  pref_ui::create "" "" general ftp
1415 
1416  }

§ file_exists()

remote::file_exists   name fname  

Definition at line 1854 of file remote.tcl.

1854  proc file_exists {name fname} {
1855 
1856  variable connections
1857  variable opened
1858 
1859  switch [lindex $connections($name) 1] {
1860  "FTP" -
1861  "SFTP" {
1862  if {![catch { ::FTP_CD $name [file dirname $fname]} rc]} {
1863  if {![catch { ::FTP_List $name 0} rc]} {
1864  return [expr {[find_fname $rc [file tail $fname]] ne ""}]
1865  } else {
1866  logger::log $rc
1867  }
1868  } else {
1869  logger::log $rc
1870  }
1871  }
1872  "WebDAV" {
1873  if {![catch { $opened($name) getstat [webdav_fname $fname]} rc]} {
1874  return 1
1875  }
1876  }
1877  }
1878 
1879  return 0
1880 
1881  }

§ find_fname()

remote::find_fname   listing fname  

Definition at line 1844 of file remote.tcl.

1844  proc find_fname {listing fname} {
1845 
1846  set match_expr [string repeat {\S+\s+} 8]
1847 
1848  return [lsearch -inline -regexp $listing "^\s*$match_expr$fname\$"]
1849 
1850  }

§ format_name()

remote::format_name   value  

Definition at line 419 of file remote.tcl.

419  proc format_name {value} {
420 
421  return [file tail $value]
422 
423  }

§ get_file()

remote::get_file   name fname encode pcontents pmodtime  

Definition at line 1975 of file remote.tcl.

1975  proc get_file {name fname encode pcontents pmodtime} {
1976 
1977  variable connections
1978  variable opened
1979 
1980  upvar $pcontents contents
1981  upvar $pmodtime modtime
1982 
1983  switch [lindex $connections($name) 1] {
1984  "FTP" -
1985  "SFTP" {
1986  set local [file join $::tke_home sftp_get.tmp]
1987  set modtime [get_mtime $name $fname]
1988  if {![catch { ::FTP_GetFile $name $fname $local 0} rc]} {
1989  if {![catch { open $local r} rc]} {
1990  fconfigure $rc -encoding $encode
1991  set contents [read $rc]
1992  close $rc
1993  file delete -force $local
1994  return 1
1995  } else {
1996  logger::log $rc
1997  }
1998  } else {
1999  logger::log $rc
2000  }
2001  }
2002  "WebDAV" {
2003  set modtime [get_mtime $name $fname]
2004  if {![catch { $opened($name) get [webdav_fname $fname]} rc]} {
2005  set contents $rc
2006  return 1
2007  } else {
2008  logger::log $rc
2009  }
2010  }
2011  }
2012 
2013  return 0
2014 
2015  }

§ get_mtime()

remote::get_mtime   name fname  

Definition at line 1885 of file remote.tcl.

1885  proc get_mtime {name fname} {
1886 
1887  variable connections
1888  variable opened
1889 
1890  switch [lindex $connections($name) 1] {
1891  "FTP" -
1892  "SFTP" {
1893  if {![catch { ::FTP_CD $name [file dirname $fname]} rc]} {
1894  if {![catch { ::FTP_List $name 0} rc]} {
1895  if {[set file_out [find_fname $rc [file tail $fname]]] ne ""} {
1896  return [clock scan [join [lrange $file_out 5 7]]]
1897  }
1898  } else {
1899  logger::log $rc
1900  }
1901  } else {
1902  logger::log $rc
1903  }
1904  }
1905  "WebDAV" {
1906  if {![catch { $opened($name) getstat [webdav_fname $fname]} rc]} {
1907  array set status $rc
1908  return $status(mtime)
1909  } else {
1910  logger::log $rc
1911  }
1912  }
1913  }
1914 
1915  return 0
1916 
1917  }

§ get_password()

remote::get_password

Definition at line 1436 of file remote.tcl.

1436  proc get_password {} {
1437 
1438  variable password
1439 
1440  set password ""
1441 
1442  toplevel .ftppass
1443  wm title .ftppass [msgcat::mc "Enter Password"]
1444  wm transient .ftppass .ftp
1445 
1446  ttk::frame .ftppass.f
1447  ttk::label .ftppass.f.l -text [msgcat::mc "Password: "]
1448  ttk::entry .ftppass.f.e -validate key -validatecommand [list remote::check_password %P] -textvariable remote::password -show * -width 30
1449 
1450  bind .ftppass.f.e <Return> [list .ftppass.bf.ok invoke]
1451 
1452  pack .ftppass.f.l -side left -padx 2 -pady 2
1453  pack .ftppass.f.e -side left -padx 2 -pady 2 -fill x -expand yes
1454 
1455  ttk::frame .ftppass.bf
1456  ttk::button .ftppass.bf.ok -style BButton -text [msgcat::mc "OK"] -width 6 -command [list remote::password_ok] -state disabled
1457  ttk::button .ftppass.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width 6 -command [list remote::password_cancel]
1458 
1459  pack .ftppass.bf.cancel -side right -padx 2 -pady 2
1460  pack .ftppass.bf.ok -side right -padx 2 -pady 2
1461 
1462  pack .ftppass.f -fill x -expand yes
1463  pack .ftppass.bf -fill x
1464 
1465  # Center the password window
1466  ::tk::PlaceWindow .ftppass widget .ftp
1467 
1468  # Get the focus/grab
1469  ::tk::SetFocusGrab .ftppass .ftppass.f.e
1470 
1471  # Wait for the window to close
1472  tkwait window .ftppass
1473 
1474  # Restore the focus/grab
1475  ::tk::RestoreFocusGrab .ftppass .ftppass.f.e
1476 
1477  return $password
1478 
1479  }

§ get_share_items()

remote::get_share_items   dir  

Definition at line 2363 of file remote.tcl.

2363  proc get_share_items {dir} {
2364 
2365  return [list remote.tkedat]
2366 
2367  }

§ group_post()

remote::group_post

Definition at line 468 of file remote.tcl.

468  proc group_post {} {
469 
470  variable widgets
471  variable opened
472 
473  # Get the selected group
474  set selected [$widgets(sb) curselection]
475 
476  # Get the group name
477  set group [$widgets(sb) cellcget $selected,name -text]
478 
479  # Figure out if any connections are currently opened in this group
480  set contains_opened [expr {[llength [array names opened $group,*]] > 0}]
481 
482  # We cannot delete the group if it is the only group or if there is at least one
483  # opened connection in the group.
484  if {([llength [$widgets(sb) childkeys root]] == 1) || $contains_opened} {
485  $widgets(group) entryconfigure [msgcat::mc "Delete Group"] -state disabled
486  } else {
487  $widgets(group) entryconfigure [msgcat::mc "Delete Group"] -state normal
488  }
489 
490  # We cannot rename the group if it has at least one opened connection
491  if {$contains_opened} {
492  $widgets(group) entryconfigure [msgcat::mc "Rename Group"] -state disabled
493  } else {
494  $widgets(group) entryconfigure [msgcat::mc "Rename Group"] -state normal
495  }
496 
497  }

§ handle_cancel()

remote::handle_cancel

Definition at line 1619 of file remote.tcl.

1619  proc handle_cancel {} {
1620 
1621  variable current_fname
1622 
1623  # Indicate that no file was chosen
1624  set current_fname ""
1625 
1626  # Close the window
1627  destroy .ftp
1628 
1629  }

§ handle_dir()

remote::handle_dir   dir  

Definition at line 1314 of file remote.tcl.

1314  proc handle_dir {dir} {
1315 
1316  variable widgets
1317  variable dir_hist
1318  variable dir_hist_index
1319  variable current_server
1320 
1321  incr dir_hist_index($current_server) $dir
1322 
1323  # Set the current directory
1324  set_current_directory [lindex $dir_hist($current_server) $dir_hist_index($current_server)] 0
1325 
1326  if {$dir_hist_index($current_server) == 0} {
1327  $widgets(dir_back) configure -state disabled -image remote_back_disabled
1328  } else {
1329  $widgets(dir_back) configure -state normal -image remote_back
1330  }
1331 
1332  if {[expr ($dir_hist_index($current_server) + 1) == [llength $dir_hist($current_server)]]} {
1333  $widgets(dir_forward) configure -state disabled -image remote_next_disabled
1334  } else {
1335  $widgets(dir_forward) configure -state normal -image remote_next
1336  }
1337 
1338  }

§ handle_dir_mb_post()

remote::handle_dir_mb_post

Definition at line 1342 of file remote.tcl.

1342  proc handle_dir_mb_post {} {
1343 
1344  variable widgets
1345  variable current_server
1346  variable current_dir
1347 
1348  # Get the directory list
1349  set dir_list [file split $current_dir($current_server)]
1350 
1351  # Clear the menu
1352  $widgets(dir_menu) delete 0 end
1353 
1354  for {set i 0} {$i < [llength $dir_list]} {incr i} {
1355  set dir [file join {*}[lrange $dir_list 0 $i]]
1356  $widgets(dir_menu) add command -label $dir -command [list remote::set_current_directory $dir 1]
1357  }
1358 
1359  }

§ handle_new_folder()

remote::handle_new_folder

Definition at line 1517 of file remote.tcl.

1517  proc handle_new_folder {} {
1518 
1519  variable widgets
1520  variable value
1521  variable current_dir
1522  variable current_server
1523 
1524  toplevel .foldwin
1525  wm title .foldwin [msgcat::mc "Create New Folder"]
1526  wm resizable .foldwin 0 0
1527  wm transient .foldwin .ftp
1528 
1529  ttk::frame .foldwin.f
1530  ttk::label .foldwin.f.l -text [format "%s: " [msgcat::mc "Folder Name"]]
1531  ttk::entry .foldwin.f.e -validate key -validatecommand [list remote::check_folder_name %P]
1532 
1533  bind .foldwin.f.e <Return> [list .foldwin.bf.ok invoke]
1534 
1535  pack .foldwin.f.l -side left -padx 2 -pady 2
1536  pack .foldwin.f.e -side left -padx 2 -pady 2 -fill x -expand yes
1537 
1538  ttk::frame .foldwin.bf
1539  ttk::button .foldwin.bf.ok -style BButton -text [msgcat::mc "Create"] -width 6 -command {
1540  set remote::value [.foldwin.f.e get]
1541  destroy .foldwin
1542  } -state disabled
1543  ttk::button .foldwin.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width 6 -command {
1544  set remote::value ""
1545  destroy .foldwin
1546  }
1547 
1548  pack .foldwin.bf.cancel -side right -padx 2 -pady 2
1549  pack .foldwin.bf.ok -side right -padx 2 -pady 2
1550 
1551  pack .foldwin.f -fill x -expand yes
1552  pack .foldwin.bf -fill x
1553 
1554  # Center the window
1555  ::tk::PlaceWindow .foldwin widget .ftp
1556 
1557  # Get the grab/focus
1558  ::tk::SetFocusGrab .foldwin .foldwin.f.e
1559 
1560  # Wait for the window to close
1561  tkwait window .foldwin
1562 
1563  # Restore the grab/focus
1564  ::tk::RestoreFocusGrab .foldwin .foldwin.f.e
1565 
1566  # Get the name of the folder to create
1567  set new_folder [file join $current_dir($current_server) $value]
1568 
1569  # Insert the new directory, if it is successfully made within FTP
1570  if {[make_directory $current_server $new_folder]} {
1571  set_current_directory $new_folder 1
1572  }
1573 
1574  }

§ handle_open()

remote::handle_open

Definition at line 1592 of file remote.tcl.

1592  proc handle_open {} {
1593 
1594  variable widgets
1595  variable current_server
1596  variable current_dir
1597  variable current_fname
1598 
1599  # Get the currently selected item
1600  set selected [$widgets(tl) curselection]
1601 
1602  # Get the filename(s)
1603  if {[$widgets(open) cget -text] eq [msgcat::mc "Open"]} {
1604  set current_fname [list]
1605  foreach select $selected {
1606  lappend current_fname [list [$widgets(tl) cellcget $select,fname -text] [$widgets(tl) cellcget $select,dir -text]]
1607  }
1608  } else {
1609  set current_fname [file join $current_dir($current_server) [$widgets(save_entry) get]]
1610  }
1611 
1612  # Kill the window
1613  destroy .ftp
1614 
1615  }

§ handle_row_moved()

remote::handle_row_moved   data  

Definition at line 441 of file remote.tcl.

441  proc handle_row_moved {data} {
442 
443  # Just save the current connections
445 
446  }

§ handle_save_entry()

remote::handle_save_entry   value  

Definition at line 451 of file remote.tcl.

451  proc handle_save_entry {value} {
452 
453  variable widgets
454  variable current_server
455 
456  if {($value eq "") || ($current_server eq "")} {
457  $widgets(open) configure -state disabled
458  } else {
459  $widgets(open) configure -state normal
460  }
461 
462  return 1
463 
464  }

§ handle_sb_double_click()

remote::handle_sb_double_click

Definition at line 833 of file remote.tcl.

833  proc handle_sb_double_click {} {
834 
835  variable widgets
836 
837  # Get the selection
838  set selected [$widgets(sb) curselection]
839 
840  # We don't want to do anything when double-clicking a group
841  if {[set parent [$widgets(sb) parentkey $selected]] eq "root"} {
842  return
843  }
844 
845  # Open the connection of the selected row
847 
848  }

§ handle_sb_select()

remote::handle_sb_select

Definition at line 805 of file remote.tcl.

805  proc handle_sb_select {} {
806 
807  variable widgets
808  variable opened
809 
810  # Get the selection
811  set selected [$widgets(sb) curselection]
812 
813  # We don't want to do anything when double-clicking a group
814  if {[set parent [$widgets(sb) parentkey $selected]] eq "root"} {
815  return
816  }
817 
818  # Get the group name
819  set group [$widgets(sb) cellcget $parent,name -text]
820 
821  # Get the remote name
822  set name "$group,[$widgets(sb) cellcget $selected,name -text]"
823 
824  # If the connection is already opened, immediately display the directory contents
825  if {[info exists opened($name)]} {
826  # open_connection
827  }
828 
829  }

§ handle_tl_double_click()

remote::handle_tl_double_click

Definition at line 1390 of file remote.tcl.

1390  proc handle_tl_double_click {} {
1391 
1392  variable widgets
1393 
1394  # Get the current selection
1395  set selected [$widgets(tl) curselection]
1396 
1397  if {[$widgets(tl) cellcget $selected,dir -text] == 0} {
1398 
1400  handle_open
1401 
1402  } else {
1403 
1404  set_current_directory [$widgets(tl) cellcget $selected,fname -text] 1
1405 
1406  }
1407 
1408  }

§ handle_tl_select()

remote::handle_tl_select

Definition at line 1363 of file remote.tcl.

1363  proc handle_tl_select {} {
1364 
1365  variable widgets
1366 
1367  # Get the currently selected row
1368  set selected [$widgets(tl) curselection]
1369 
1370  # If the selected item is a file
1371  if {([$widgets(open) cget -text] eq [msgcat::mc "Open"]) || \
1372  ([$widgets(tl) cellcget $selected,dir -text] == 0)} {
1373 
1374  # Populate the save entry field
1375  $widgets(save_entry) delete 0 end
1376  $widgets(save_entry) insert end [file tail [$widgets(tl) cellcget $selected,fname -text]]
1377 
1378  if {[$widgets(save_entry) get] ne ""} {
1379  $widgets(open) configure -state normal
1380  } else {
1381  $widgets(open) configure -state disabled
1382  }
1383 
1384  }
1385 
1386  }

§ initialize()

remote::initialize

Definition at line 44 of file remote.tcl.

44  proc initialize {} {
45 
46  variable initialized
47 
48  if {!$initialized} {
49 
50  # Create images
51  theme::register_image remote_connecting bitmap ttk_style background \
52  {msgcat::mc "Image used in remote file selector to indicate that a connection is being opened."} \
53  -file [file join $::tke_dir lib images connecting.bmp] \
54  -maskfile [file join $::tke_dir lib images connecting.bmp] \
55  -foreground 2
56 
57  theme::register_image remote_connected bitmap ttk_style background \
58  {msgcat::mc "Image used in remote file selector to indicate that a connection is opened."} \
59  -file [file join $::tke_dir lib images connected.bmp] \
60  -maskfile [file join $::tke_dir lib images connected.bmp] \
61  -foreground 2
62 
63  theme::register_image remote_directory bitmap ttk_style background \
64  {msgcat::mc "Image used in remote file selector to indicate a folder."} \
65  -file [file join $::tke_dir lib images right.bmp] \
66  -maskfile [file join $::tke_dir lib images right.bmp] \
67  -foreground 0
68 
69  theme::register_image remote_file bitmap ttk_style background \
70  {msgcat::mc "Image used in remote file selector to indicate a file."} \
71  -file [file join $::tke_dir lib images blank.bmp] \
72  -maskfile [file join $::tke_dir lib images blank.bmp] \
73  -foreground 0
74 
75  theme::register_image remote_back bitmap ttk_style background \
76  {msgcat::mc "Image used in remote file selector for the history back button."} \
77  -file [file join $::tke_dir lib images left.bmp] \
78  -maskfile [file join $::tke_dir lib images left.bmp] \
79  -foreground 2
80 
81  theme::register_image remote_back_disabled bitmap ttk_style background \
82  {msgcat::mc "Image used in remote file selector for the history back button."} \
83  -file [file join $::tke_dir lib images left.bmp] \
84  -maskfile [file join $::tke_dir lib images left.bmp] \
85  -foreground 0
86 
87  theme::register_image remote_next bitmap ttk_style background \
88  {msgcat::mc "Image used in remote file selector for the history forward button."} \
89  -file [file join $::tke_dir lib images right.bmp] \
90  -maskfile [file join $::tke_dir lib images right.bmp] \
91  -foreground 2
92 
93  theme::register_image remote_next_disabled bitmap ttk_style background \
94  {msgcat::mc "Image used in remote file selector for the history forward button."} \
95  -file [file join $::tke_dir lib images right.bmp] \
96  -maskfile [file join $::tke_dir lib images right.bmp] \
97  -foreground 0
98 
99  set initialized 1
100 
101  }
102 
103  }

§ load_connections()

remote::load_connections

Definition at line 2268 of file remote.tcl.

2268  proc load_connections {} {
2269 
2270  variable widgets
2271  variable groups
2272  variable connections
2273  variable opened
2274  variable remote_file
2275 
2276  # Clear the connections
2277  array unset connections
2278 
2279  # Clear the table
2280  $widgets(sb) delete 0 end
2281 
2282  if {![catch { tkedat::read $remote_file 0} rc]} {
2283  array set data $rc
2284  foreach key [lsort -dictionary [array names data]] {
2285  lassign [split $key ,] num group name
2286  if {![info exists groups($group)]} {
2287  set groups($group) [$widgets(sb) insertchild root end $group]
2288  }
2289  if {[llength $data($key)] >= 7} {
2290  set data($key) [lreplace $data($key) 3 3 [base64::decode [lindex $data($key) 3]]]
2291  set data($key) [lreplace $data($key) 6 6]
2292  }
2293  set row [$widgets(sb) insertchild $groups($group) end [list $name $data($key) [lindex $data($key) 3]]]
2294  set connections($group,$name) [list $row {*}$data($key)]
2295  if {[info exists opened($group,$name)]} {
2296  $widgets(sb) cellconfigure $row,name -image remote_connected
2297  }
2298  }
2299  }
2300 
2301  # If the table is empty, make sure that at least one group exists
2302  if {[$widgets(sb) size] == 0} {
2303  set groups(Group) [$widgets(sb) insertchild root end [msgcat::mc "Group"]]
2304  }
2305 
2306  }

§ make_directory()

remote::make_directory   name dirname  

Definition at line 2063 of file remote.tcl.

2063  proc make_directory {name dirname} {
2064 
2065  variable connections
2066  variable opened
2067 
2068  # Make the directory remotely
2069  switch [lindex $connections($name) 1] {
2070  "FTP" -
2071  "SFTP" {
2072  if {![catch { ::FTP_MkDir $name $dirname} rc]} {
2073  return 1
2074  } else {
2075  logger::log $rc
2076  }
2077  }
2078  "WebDAV" {
2079  if {![catch { $opened($name) mkdir [webdav_fname $dirname]} rc]} {
2080  return 1
2081  } else {
2082  logger::log $rc
2083  }
2084  }
2085  }
2086 
2087  return 0
2088 
2089  }

§ new_connection()

remote::new_connection

Definition at line 1093 of file remote.tcl.

1093  proc new_connection {} {
1094 
1095  variable widgets
1096 
1097  # Get the current selection and group name
1098  if {[set selected [$widgets(sb) curselection]] eq ""} {
1099  set group_name [$widgets(sb) cellcget [lindex [$widgets(sb) childkeys root] 0],name -text]
1100  } elseif {[$widgets(sb) parentkey $selected] eq "root"} {
1101  set group_name [$widgets(sb) cellcget $selected,name -text]
1102  } else {
1103  set group_name [$widgets(sb) cellcget [$widgets(sb) parentkey $selected],name -text]
1104  }
1105 
1106  # Clear out the editor fields
1108 
1109  # Setup field names
1110  $widgets(edit_type) configure -text "FTP"
1111  $widgets(edit_group) configure -text $group_name
1112  $widgets(edit_port) insert end 21
1113 
1114  # Set the create button text to Create
1115  $widgets(edit_create) configure -text [msgcat::mc "Create"]
1116 
1117  # Make the editor pane visible
1118  pack forget $widgets(pw)
1119  pack $widgets(editor) -fill both -expand yes
1120 
1121  }

§ new_group()

remote::new_group

Definition at line 898 of file remote.tcl.

898  proc new_group {} {
899 
900  variable widgets
901  variable value
902  variable groups
903 
904  set value ""
905 
906  toplevel .groupwin
907  wm title .groupwin [msgcat::mc "New Group"]
908  wm resizable .groupwin 0 0
909  wm transient .groupwin .ftp
910 
911  ttk::frame .groupwin.f
912  ttk::label .groupwin.f.l -text [msgcat::mc "Group Name: "]
913  ttk::entry .groupwin.f.e -validate key -validatecommand [list remote::validate_group %P]
914 
915  bind .groupwin.f.e <Return> [list .groupwin.bf.create invoke]
916 
917  pack .groupwin.f.l -side left -padx 2 -pady 2
918  pack .groupwin.f.e -side left -padx 2 -pady 2 -fill x -expand yes
919 
920  ttk::frame .groupwin.bf
921  ttk::button .groupwin.bf.create -style BButton -text [msgcat::mc "Create"] -width 6 -command {
922  set remote::value [.groupwin.f.e get]
923  destroy .groupwin
924  } -state disabled
925  ttk::button .groupwin.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width 6 -command {
926  set remote::value ""
927  destroy .groupwin
928  }
929 
930  pack .groupwin.bf.cancel -side right -padx 2 -pady 2
931  pack .groupwin.bf.create -side right -padx 2 -pady 2
932 
933  pack .groupwin.f -fill x -expand yes
934  pack .groupwin.bf -fill x
935 
936  # Place the window in the middle of the FTP window
937  ::tk::PlaceWindow .groupwin widget .ftp
938 
939  # Get the focus/grab
940  ::tk::SetFocusGrab .groupwin .groupwin.f.e
941 
942  # Wait for the window to close
943  tkwait window .groupwin
944 
945  # Restore the focus/grab
946  ::tk::RestoreFocusGrab .groupwin .groupwin.f.e
947 
948  # Add the group to the sidebar table
949  if {$value ne ""} {
950  set groups($value) [$widgets(sb) insertchild root end [list $value "" ""]]
951  $widgets(sb) selection clear 0 end
952  $widgets(sb) selection set $groups($value)
953  }
954 
955  }

§ open_connection()

remote::open_connection

Definition at line 1125 of file remote.tcl.

1125  proc open_connection {} {
1126 
1127  variable widgets
1128  variable current_server
1129  variable images
1130  variable opened
1131  variable dir_hist
1132  variable dir_hist_index
1133 
1134  # Get the selection
1135  set selected [$widgets(sb) curselection]
1136 
1137  # Get the group name
1138  set parent [$widgets(sb) parentkey $selected]
1139  set group [$widgets(sb) cellcget $parent,name -text]
1140 
1141  # Get the connection name to load
1142  set current_server "$group,[$widgets(sb) cellcget $selected,name -text]"
1143 
1144  # Get settings
1145  set settings [$widgets(sb) cellcget $selected,settings -text]
1146 
1147  if {[info exists opened($current_server)]} {
1148 
1149  # Set the current directory
1150  set_current_directory [lindex $settings 5] 1
1151 
1152  # Indicate that the we are connected
1153  $widgets(sb) cellconfigure $selected,name -image remote_connected
1154 
1155  # Make sure that the Open/Save button is enabled
1156  if {([$widgets(open) configure -text] eq [msgcat::mc "Open"]) || \
1157  ([$widgets(save_entry) get] ne "")} {
1158  $widgets(open) configure -state normal
1159  }
1160 
1161  } else {
1162 
1163  # Set the image to indicate that we are connecting
1164  $widgets(sb) cellconfigure $selected,name -image remote_connecting
1165 
1166  # Connect to the FTP server and add the directory
1167  if {[connect $current_server]} {
1168 
1169  # Clear the directory history
1170  set dir_hist($current_server) [list]
1171  set dir_hist_index($current_server) 0
1172 
1173  # Display the current directory
1174  set_current_directory [lindex $settings 5] 1
1175 
1176  # Indicate that we have successfully connected to the server
1177  $widgets(sb) cellconfigure $selected,name -image remote_connected
1178 
1179  # Make sure that the Open/Save button is enabled
1180  if {([$widgets(open) configure -text] eq [msgcat::mc "Open"]) || \
1181  ([$widgets(save_entry) get] ne "")} {
1182  $widgets(open) configure -state normal
1183  }
1184 
1185  # If we fail to connect, clear the connecting icon
1186  } else {
1187  $widgets(sb) cellconfigure $selected,name -image ""
1188  }
1189 
1190  }
1191 
1192  }

§ password_cancel()

remote::password_cancel

Definition at line 1505 of file remote.tcl.

1505  proc password_cancel {} {
1506 
1507  variable password
1508 
1509  set password ""
1510 
1511  destroy .ftppass
1512 
1513  }

§ password_ok()

remote::password_ok

Definition at line 1497 of file remote.tcl.

1497  proc password_ok {} {
1498 
1499  destroy .ftppass
1500 
1501  }

§ populate_group_menu()

remote::populate_group_menu

Definition at line 642 of file remote.tcl.

642  proc populate_group_menu {} {
643 
644  variable widgets
645 
646  # Remove all items from the group popup menu
647  .ftp.egroupPopup delete 0 end
648 
649  foreach group_key [$widgets(sb) childkeys root] {
650  set group [$widgets(sb) cellcget $group_key,name -text]
651  .ftp.egroupPopup add command -label $group -command [list remote::change_group $group]
652  }
653 
654  }

§ populate_sidebar()

remote::populate_sidebar

Definition at line 1420 of file remote.tcl.

1420  proc populate_sidebar {} {
1421 
1422  variable widgets
1423  variable groups
1424  variable current_server
1425 
1426  # Clear variables
1427  array unset groups
1428 
1429  # Read the contents of the FTP file and load them into the sidebar table
1431 
1432  }

§ quick_load_connections()

remote::quick_load_connections

Definition at line 2312 of file remote.tcl.

2312  proc quick_load_connections {} {
2313 
2314  variable connections
2315  variable remote_file
2316 
2317  array unset connections
2318 
2319  if {![catch { tkedat::read $remote_file 0} rc]} {
2320  array set data $rc
2321  foreach key [array names data] {
2322  lassign [split $key ,] num group name
2323  if {[llength $data($key)] >= 7} {
2324  set data($key) [lreplace $data($key) 3 3 [base64::decode [lindex $data($key) 3]]]
2325  set data($key) [lreplace $data($key) 6 6]
2326  }
2327  set connections($group,$name) [list "" {*}$data($key)]
2328  }
2329  }
2330 
2331  }

§ remove_directories()

remote::remove_directories   name dirnames args  

Definition at line 2093 of file remote.tcl.

2093  proc remove_directories {name dirnames args} {
2094 
2095  variable connections
2096  variable opened
2097 
2098  array set opts {
2099  -force 0
2100  }
2101  array set opts $args
2102 
2103  set retval 1
2104 
2105  # Delete the list of directories
2106  switch [lindex $connections($name) 1] {
2107  "FTP" -
2108  "SFTP" {
2109  if {$opts(-force)} {
2110  foreach dirname $dirnames {
2111  set items [list]
2112  if {[dir_contents $name $dirname items]} {
2113  foreach item $items {
2114  lassign $item fname isdir
2115  if {$isdir} {
2116  if {![remove_directories $name $fname -force 1]} {
2117  set retval 0
2118  }
2119  } else {
2120  if {![remove_files $name $fname]} {
2121  set retval 0
2122  }
2123  }
2124  }
2125  if {[catch { ::FTP_RmDir $name $dirname} rc]} {
2126  logger::log $rc
2127  set retval 0
2128  }
2129  }
2130  }
2131  } else {
2132  foreach dirname $dirnames {
2133  if {[catch { ::FTP_RmDir $name $dirname} rc]} {
2134  logger::log $rc
2135  set retval 0
2136  }
2137  }
2138  }
2139  }
2140  "WebDAV" {
2141  foreach dirname $dirnames {
2142  if {[catch { $opened($name) delete [webdav_fname $dirname]} rc]} {
2143  logger::log $rc
2144  set retval 0
2145  }
2146  }
2147  }
2148  default {
2149  set retval 0
2150  }
2151  }
2152 
2153  return $retval
2154 
2155  }

§ remove_files()

remote::remove_files   name fnames  

Definition at line 2231 of file remote.tcl.

2231  proc remove_files {name fnames} {
2232 
2233  variable connections
2234  variable opened
2235 
2236  set retval 1
2237 
2238  # Delete the list of directories
2239  switch [lindex $connections($name) 1] {
2240  "FTP" -
2241  "SFTP" {
2242  foreach fname $fnames {
2243  if {[catch { ::FTP_Delete $name $fname} rc]} {
2244  logger::log $rc
2245  set retval 0
2246  }
2247  }
2248  }
2249  "WebDAV" {
2250  foreach fname $fnames {
2251  if {[catch { $opened($name) delete [webdav_fname $fname]} rc]} {
2252  logger::log $rc
2253  set retval 0
2254  }
2255  }
2256  }
2257  default {
2258  set retval 0
2259  }
2260  }
2261 
2262  return $retval
2263 
2264  }

§ rename_file()

remote::rename_file   name curr_fname new_fname  

Definition at line 2159 of file remote.tcl.

2159  proc rename_file {name curr_fname new_fname} {
2160 
2161  variable connections
2162  variable opened
2163 
2164  # Change the current directory
2165  switch [lindex $connections($name) 1] {
2166  "FTP" -
2167  "SFTP" {
2168  if {![catch { ::FTP_Rename $name $curr_fname $new_fname} rc]} {
2169  return 1
2170  } else {
2171  logger::log $rc
2172  }
2173  }
2174  "WebDAV" {
2175  if {![catch { $opened($name) copy [webdav_fname $curr_fname] [webdav_fname $new_fname]} rc]} {
2176  if {![catch { $opened($name) delete [webdav_fname $curr_fname]} rc]} {
2177  return 1
2178  } else {
2179  logger::log $rc
2180  }
2181  } else {
2182  logger::log $rc
2183  }
2184  }
2185  }
2186 
2187  return 0
2188 
2189  }

§ rename_group()

remote::rename_group

Definition at line 973 of file remote.tcl.

973  proc rename_group {} {
974 
975  variable widgets
976  variable value
977  variable groups
978 
979  # Get the currently selected group
980  set selected [$widgets(sb) curselection]
981  set old_value [$widgets(sb) cellcget $selected,name -text]
982  set value ""
983 
984  toplevel .renwin
985  wm title .renwin [format "%s %s" [msgcat::mc "Rename Group"] $old_value]
986  wm resizable .renwin 0 0
987  wm transient .renwin .ftp
988 
989  ttk::frame .renwin.f
990  ttk::label .renwin.f.l -text [format "%s: " [msgcat::mc "Group Name"]]
991  ttk::entry .renwin.f.e -validate key -validatecommand [list remote::validate_rename_group %P]
992 
993  bind .renwin.f.e <Return> [list .renwin.bf.ok invoke]
994 
995  pack .renwin.f.l -side left -padx 2 -pady 2
996  pack .renwin.f.e -side left -padx 2 -pady 2 -fill x -expand yes
997 
998  ttk::frame .renwin.bf
999  ttk::button .renwin.bf.ok -style BButton -text [msgcat::mc "Rename"] -width 6 -command {
1000  set remote::value [.renwin.f.e get]
1001  destroy .renwin
1002  } -state disabled
1003  ttk::button .renwin.bf.cancel -style BButton -text [msgcat::mc "Cancel"] -width 6 -command {
1004  set remote::value ""
1005  destroy .renwin
1006  }
1007 
1008  pack .renwin.bf.cancel -side right -padx 2 -pady 2
1009  pack .renwin.bf.ok -side right -padx 2 -pady 2
1010 
1011  pack .renwin.f -fill x -expand yes
1012  pack .renwin.bf -fill x
1013 
1014  # Place the window in the middle of the FTP window
1015  ::tk::PlaceWindow .renwin widget .ftp
1016 
1017  # Get the focus/grab
1018  ::tk::SetFocusGrab .renwin .renwin.f.e
1019 
1020  # Wait for the window to close
1021  tkwait window .renwin
1022 
1023  # Restore the focus/grab
1024  ::tk::RestoreFocusGrab .renwin .renwin.f.e
1025 
1026  # Add the group to the sidebar table
1027  if {$value ne ""} {
1028  $widgets(sb) cellconfigure $selected,name -text $value
1029  unset groups($old_value)
1030  set groups($value) $selected
1032  }
1033 
1034  }

§ save_connections()

remote::save_connections

Definition at line 2335 of file remote.tcl.

2335  proc save_connections {} {
2336 
2337  variable widgets
2338  variable connections
2339  variable remote_file
2340 
2341  array unset connections
2342 
2343  # Gather the data to save from the table
2344  set num 0
2345  foreach group_key [$widgets(sb) childkeys root] {
2346  set group [$widgets(sb) cellcget $group_key,name -text]
2347  foreach conn_key [$widgets(sb) childkeys $group_key] {
2348  set name [$widgets(sb) cellcget $conn_key,name -text]
2349  set settings [$widgets(sb) cellcget $conn_key,settings -text]
2350  lappend data "$num,$group,$name" [list {*}[lreplace $settings 3 3 [base64::encode [lindex $settings 3]]] 1]
2351  set connections($group,$name) [list $conn_key {*}[lreplace $settings 3 3 [$widgets(sb) cellcget $conn_key,passwd -text]]]
2352  incr num
2353  }
2354  }
2355 
2356  # Write the information to file
2357  catch { tkedat::write $remote_file $data 0}
2358 
2359  }

§ save_file()

remote::save_file   name fname encode contents pmodtime  

Definition at line 2020 of file remote.tcl.

2020  proc save_file {name fname encode contents pmodtime} {
2021 
2022  variable connections
2023  variable opened
2024 
2025  upvar $pmodtime modtime
2026 
2027  switch [lindex $connections($name) 1] {
2028  "FTP" -
2029  "SFTP" {
2030  set local [file join $::tke_home sftp_put.tmp]
2031  if {![catch { open $local w} rc]} {
2032  fconfigure $rc -encoding $encode
2033  puts $rc $contents
2034  close $rc
2035  if {![catch { ::FTP_PutFile $name $local $fname [file size $local]} rc]} {
2036  set modtime [get_mtime $name $fname]
2037  file delete -force $local
2038  return 1
2039  } else {
2040  logger::log $rc
2041  file delete -force $local
2042  }
2043  } else {
2044  logger::log $rc
2045  }
2046  }
2047  "WebDAV" {
2048  if {![catch { $opened($name) put [webdav_fname $fname] $contents} rc]} {
2049  set modtime [get_mtime $name $fname]
2050  return 1
2051  } else {
2052  logger::log $rc
2053  }
2054  }
2055  }
2056 
2057  return 0
2058 
2059  }

§ set_current_directory()

remote::set_current_directory   directory update_hist  

Definition at line 1633 of file remote.tcl.

1633  proc set_current_directory {directory update_hist} {
1634 
1635  variable widgets
1636  variable current_server
1637  variable current_dir
1638  variable dir_hist
1639  variable dir_hist_index
1640  variable connections
1641 
1642  # Get the current tablelist cursor
1643  set orig_cursor [$widgets(tl) cget -cursor]
1644 
1645  # Set the tablelist cursor to be busy cursor
1646  $widgets(tl) configure -cursor [ttk::cursor busy]
1647 
1648  # If the directory is empty, get the current directory
1649  if {$directory eq ""} {
1650  switch [lindex $connections($current_server) 1] {
1651  "FTP" -
1652  "SFTP" {
1653  set directory [::FTP_PWD $current_server]
1654  }
1655  "WebDAV" {
1656  set directory "."
1657  }
1658  }
1659  }
1660 
1661  # Add the new directory
1662  set items [list]
1663  if {![dir_contents $current_server $directory items]} {
1664  tk_messageBox -parent .ftp -icon error -type ok -default ok -message [msgcat::mc "Unable to read remote directory contents."] -detail $directory
1665  return
1666  }
1667 
1668  # Delete the children of the given parent in the table
1669  $widgets(tl) delete 0 end
1670 
1671  # Add the directories first
1672  foreach fname [lsort -index 0 [lsearch -all -inline -index 1 $items 1]] {
1673  set row [$widgets(tl) insert end $fname]
1674  $widgets(tl) cellconfigure $row,fname -image remote_directory
1675  }
1676 
1677  # Add the files second
1678  foreach fname [lsort -index 0 [lsearch -all -inline -index 1 $items 0]] {
1679  set row [$widgets(tl) insert end $fname]
1680  $widgets(tl) cellconfigure $row,fname -image remote_file
1681  }
1682 
1683  # Reset the tablelist cursor to be busy cursor
1684  $widgets(tl) configure -cursor $orig_cursor
1685 
1686  # Sets the current directory to the provided value
1687  set current_dir($current_server) $directory
1688 
1689  # Update the state/text of the menubutton
1690  $widgets(dir_mb) configure -text $directory -state normal
1691 
1692  # Update the directory history
1693  if {$update_hist} {
1694  catch { set dir_hist($current_server) [lreplace $dir_hist($current_server) [expr $dir_hist_index($current_server) + 1] end]}
1695  lappend dir_hist($current_server) $directory
1696  set dir_hist_index($current_server) [expr [llength $dir_hist($current_server)] - 1]
1697  if {[llength $dir_hist($current_server)] == 1} {
1698  $widgets(dir_back) configure -state disabled -image remote_back_disabled
1699  } else {
1700  $widgets(dir_back) configure -state normal -image remote_back
1701  }
1702  $widgets(dir_forward) configure -state disabled -image remote_next_disabled
1703  }
1704 
1705  # Enable the New Folder button
1706  $widgets(folder) configure -state normal
1707 
1708  }

§ share_changed()

remote::share_changed   dir  

Definition at line 2371 of file remote.tcl.

2371  proc share_changed {dir} {
2372 
2373  variable remote_file
2374 
2375  set remote_file [file join $dir remote.tkedat]
2376 
2377  }

§ show_new_menu()

remote::show_new_menu

Definition at line 879 of file remote.tcl.

879  proc show_new_menu {} {
880 
881  variable widgets
882 
883  set menu_width [winfo reqwidth $widgets(new)]
884  set menu_height [winfo reqheight $widgets(new)]
885  set w_width [winfo width $widgets(new_b)]
886  set w_x [winfo rootx $widgets(new_b)]
887  set w_y [winfo rooty $widgets(new_b)]
888 
889  set x $w_x
890  set y [expr $w_y - ($menu_height + 4)]
891 
892  tk_popup $widgets(new) $x $y
893 
894  }

§ show_sidebar_menu()

remote::show_sidebar_menu   W x y X Y  

Definition at line 852 of file remote.tcl.

852  proc show_sidebar_menu {W x y X Y} {
853 
854  variable widgets
855 
856  foreach {tbl x y} [tablelist::convEventFields $W $x $y] {}
857 
858  set row [$tbl containing $y]
859  if {$row == -1} {
860  return
861  }
862 
863  # Set the current selection
864  $widgets(sb) selection clear 0 end
865  $widgets(sb) selection set $row
866 
867  if {[$widgets(sb) parentkey $row] eq "root"} {
868  set mnu $widgets(group)
869  } else {
870  set mnu $widgets(connection)
871  }
872 
873  tk_popup $mnu $X $Y
874 
875  }

§ test_connection()

remote::test_connection   edit_mode  

Definition at line 537 of file remote.tcl.

537  proc test_connection {edit_mode} {
538 
539  variable widgets
540  variable connections
541 
542  # Get the field values
543  if {$edit_mode} {
544  set type [$widgets(edit_type) cget -text]
545  set group [$widgets(edit_group) cget -text]
546  set name [$widgets(edit_name) get]
547  set server [$widgets(edit_server) get]
548  set user [$widgets(edit_user) get]
549  set passwd [$widgets(edit_passwd) get]
550  set port [$widgets(edit_port) get]
551  set dir [$widgets(edit_dir) get]
552  } else {
553  set selected [$widgets(sb) curselection]
554  set group [$widgets(sb) cellcget [$widgets(sb) parentkey $selected],name -text]
555  set name [$widgets(sb) cellcget $selected,name -text]
556  lassign $connections($group,$name) key type server user passwd port dir
557  }
558 
559  # Get a password from the user if it is not set
560  if {$passwd eq ""} {
561  if {[set passwd [get_password]] eq ""} {
562  return
563  }
564  }
565 
566  # Open and initialize the connection
567  switch $type {
568  "FTP" {
569  if {[set connection [::ftp::Open $server $user $passwd -port $port -timeout 60]] == -1} {
570  tk_messageBox -parent .ftp -icon info -type ok -default ok -message [msgcat::mc "Connection failed"]
571  } else {
572  ::ftp::Close $connection
573  tk_messageBox -parent .ftp -icon info -type ok -default ok -message [msgcat::mc "Connection passed"]
574  }
575  }
576  "SFTP" {
577  if {[::sFTPopen test $server $user $passwd $port 60] == -1} {
578  tk_messageBox -parent .ftp -icon info -type ok -default ok -message [msgcat::mc "Connection failed"]
579  } else {
580  ::sFTPclose test
581  tk_messageBox -parent .ftp -icon info -type ok -default ok -message [msgcat::mc "Connection passed"]
582  }
583  }
584  "WebDAV" {
585  if {[catch { webdav::connect $server -username $user -password $passwd} w]} {
586  tk_messageBox -parent .ftp -icon info -type ok -default ok -message [msgcat::mc "Connection failed"]
587  } else {
588  $w close
589  tk_messageBox -parent .ftp -icon info -type ok -default ok -message [msgcat::mc "Connection passed"]
590  }
591  }
592  }
593 
594  }

§ update_connection()

remote::update_connection

Definition at line 598 of file remote.tcl.

598  proc update_connection {} {
599 
600  variable widgets
601  variable groups
602 
603  # Get the field values
604  set type [$widgets(edit_type) cget -text]
605  set group [$widgets(edit_group) cget -text]
606  set name [$widgets(edit_name) get]
607  set server [$widgets(edit_server) get]
608  set user [$widgets(edit_user) get]
609  set passwd [$widgets(edit_passwd) get]
610  set port [$widgets(edit_port) get]
611  set dir [$widgets(edit_dir) get]
612 
613  # Create the settings list
614  set settings [list $type $server $user $passwd $port $dir]
615 
616  # Update the sidebar
617  if {[$widgets(edit_create) cget -text] eq [msgcat::mc "Create"]} {
618  $widgets(sb) insertchild $groups($group) end [list $name $settings $passwd]
619  } else {
620  set selected [$widgets(sb) curselection]
621  set current_group [$widgets(sb) cellcget [$widgets(sb) parentkey $selected],name -text]
622  set current_name [$widgets(sb) cellcget $selected,name -text]
623  if {$group ne $current_group} {
624  $widgets(sb) delete $selected
625  $widgets(sb) insertchild $groups($group) end [list $name $settings $passwd]
626  } else {
627  $widgets(sb) rowconfigure $selected -text [list $name $settings $passwd]
628  }
629  }
630 
631  # Write the connection information to file
633 
634  # Make the file table visible
635  pack forget $widgets(editor)
636  pack $widgets(pw) -fill both -expand yes
637 
638  }

§ validate_group()

remote::validate_group   value  

Definition at line 959 of file remote.tcl.

959  proc validate_group {value} {
960 
961  if {$value eq ""} {
962  .groupwin.bf.create configure -state disabled
963  } else {
964  .groupwin.bf.create configure -state normal
965  }
966 
967  return 1
968 
969  }

§ validate_rename_group()

remote::validate_rename_group   value  

Definition at line 1038 of file remote.tcl.

1038  proc validate_rename_group {value} {
1039 
1040  variable widgets
1041 
1042  if {$value eq ""} {
1043  .renwin.bf.ok configure -state disabled
1044  } else {
1045  .renwin.bf.ok configure -state normal
1046  }
1047 
1048  return 1
1049 
1050  }

§ webdav_fname()

remote::webdav_fname   fname  

Definition at line 2381 of file remote.tcl.

2381  proc webdav_fname {fname} {
2382 
2383  set file_list [file split $fname]
2384 
2385  if {[lindex $file_list 0] eq "."} {
2386  set file_list [lrange $file_list 1 end]
2387  }
2388 
2389  return [string map {{ } {%20}} [file join {*}$file_list]]
2390 
2391  }