00001 # TKE - Advanced Programmer's Editor
00002 # Copyright (C) 2014-2019 Trevor Williams (phase1geo@gmail.com)
00003 #
00004 # This program is free software; you can redistribute it and/or modify
00005 # it under the terms of the GNU General Public License as published by
00006 # the Free Software Foundation; either version 2 of the License, or
00007 # (at your option) any later version.
00008 #
00009 # This program is distributed in the hope that it will be useful,
00010 # but WITHOUT ANY WARRANTY; without even the implied warranty of
00011 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
00012 # GNU General Public License for more details.
00013 #
00014 # You should have received a copy of the GNU General Public License along
00015 # with this program; if not, write to the Free Software Foundation, Inc.,
00016 # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
00017
00018 ######################################################################
00019 # Name: files.tcl
00020 # Author: Trevor Williams (trevorw@sgi.com)
00021 # Date: 11/22/2016
00022 # Brief: Handles all file-related functionality.
00023 ######################################################################
00024
00025 namespace eval files {
00026
00027 variable files {}
00028
00029 array set fields {
00030 fname 0
00031 mtime 1
00032 save_cmd 2
00033 tab 3
00034 lock 4
00035 readonly 5
00036 sidebar 6
00037 modified 7
00038 buffer 8
00039 gutters 9
00040 diff 10
00041 tags 11
00042 loaded 12
00043 eol 13
00044 remember 14
00045 remote 15
00046 xview 16
00047 yview 17
00048 cursor 18
00049 encode 19
00050 }
00051
00052 ######################################################################
00053 # PUBLIC PROCEDURES
00054 ######################################################################
00055
00056 ######################################################################
00057 # Returns a list of information based on the types of data requested
00058 # in the parameters for the given file.
00059 proc get_info {from from_type args} {
00060
00061 variable files
00062 variable fields
00063
00064 switch $from_type {
00065 tab {
00066 set index [lsearch -index $fields(tab) $files $from]
00067 }
00068 fileindex {
00069 set index $from
00070 }
00071 }
00072
00073 # Verify that we found a matching file
00074 if {$index == -1} {
00075 return -code error "files::get_info, Unable to find file with attribute ($from_type) and value ($from)"
00076 }
00077
00078 set i 0
00079 foreach to_type $args {
00080 upvar $to_type type$i
00081 if {$to_type eq "fileindex"} {
00082 set retval [set type$i $index]
00083 } elseif {[info exists fields($to_type)]} {
00084 set retval [set type$i [lindex $files $index $fields($to_type)]]
00085 } else {
00086 return -code error "files::get_info, Unsupported to_type ($to_type)"
00087 }
00088 incr i
00089 }
00090
00091 return $retval
00092
00093 }
00094
00095 ######################################################################
00096 # Sets one or more file fields for the given file.
00097 proc set_info {from from_type args} {
00098
00099 variable files
00100 variable fields
00101
00102 switch $from_type {
00103 tab {
00104 set index [lsearch -index $fields(tab) $files $from]
00105 }
00106 fileindex {
00107 set index $from
00108 }
00109 }
00110
00111 # Verify that we found a matching file
00112 if {$index == -1} {
00113 return -code error "files::get_info, Unable to find file with attribute ($from_type) and value ($from)"
00114 }
00115
00116 foreach {type value} $args {
00117 if {![info exists fields($type)]} {
00118 return -code error "files::set_info, Unsupported to_type ($type)"
00119 }
00120 lset files $index $fields($type) $value
00121 }
00122
00123 }
00124
00125 ######################################################################
00126 # Returns the number of opened files.
00127 proc get_file_num {} {
00128
00129 variable files
00130
00131 return [llength $files]
00132
00133 }
00134
00135 ######################################################################
00136 # Returns the list of opened files.
00137 proc get_indices {field {pattern *}} {
00138
00139 variable files
00140 variable fields
00141
00142 if {![info exists fields($field)]} {
00143 return -code error "Unknown file field ($field)"
00144 }
00145
00146 return [lsearch -all -index $fields($field) $files $pattern]
00147
00148 }
00149
00150 ######################################################################
00151 # Returns the list of all opened tabs.
00152 proc get_tabs {{pattern *}} {
00153
00154 variable files
00155 variable fields
00156
00157 set tabs [list]
00158 foreach t [lsearch -all -index $fields(tab) -inline $files $pattern] {
00159 lappend tabs [lindex $t $fields(tab)]
00160 }
00161
00162 return $tabs
00163
00164 }
00165
00166 ######################################################################
00167 # Returns 1 if the given filename exists (either locally or remotely).
00168 proc exists {index} {
00169
00170 get_info $index fileindex fname remote
00171
00172 if {$remote eq ""} {
00173 return [file exists $fname]
00174 } else {
00175 return [remote::file_exists $remote $fname]
00176 }
00177
00178 }
00179
00180 ######################################################################
00181 # Returns true if the file is currently opened within an editing buffer.
00182 proc is_opened {fname remote} {
00183
00184 return [expr [get_index $fname $remote] != -1]
00185
00186 }
00187
00188 ######################################################################
00189 # Counts the number of opened files in the given directory.
00190 proc num_opened {fname remote} {
00191
00192 variable files
00193 variable fields
00194
00195 set count 0
00196
00197 foreach index [lsearch -all -index $fields(fname) $files $fname*] {
00198 incr count [expr {[lindex $files $index $fields(remote)] eq $remote}]
00199 }
00200
00201 return $count
00202
00203 }
00204
00205 ######################################################################
00206 # Returns the index of the matching filename.
00207 proc get_index {fname remote args} {
00208
00209 variable files
00210 variable fields
00211
00212 array set opts {
00213 -diff 0
00214 -buffer 0
00215 }
00216 array set opts $args
00217
00218 foreach index [lsearch -all -index $fields(fname) $files $fname] {
00219 if {([lindex $files $index $fields(remote)] eq $remote) && \
00220 ([lindex $files $index $fields(diff)] eq $opts(-diff)) && \
00221 ([lindex $files $index $fields(buffer)] eq $opts(-buffer))} {
00222 return $index
00223 }
00224 }
00225
00226 return -1
00227
00228 }
00229
00230 ######################################################################
00231 # Returns the modification time of the given file (either locally or
00232 # remotely).
00233 proc modtime {index} {
00234
00235 get_info $index fileindex fname remote
00236
00237 if {$remote eq ""} {
00238 file stat $fname stat
00239 return $stat(mtime)
00240 } else {
00241 return [remote::get_mtime $remote $fname]
00242 }
00243
00244 }
00245
00246 ######################################################################
00247 # Normalizes the given filename and resolves any NFS mount information if
00248 # the specified host is not the current host.
00249 proc normalize {host fname} {
00250
00251 # Perform a normalization of the file
00252 set fname [file normalize $fname]
00253
00254 # If the host does not match our host, handle the NFS mount normalization
00255 if {$host ne [info hostname]} {
00256 array set nfs_mounts [preferences::get NFSMounts]
00257 if {[info exists nfs_mounts($host)]} {
00258 lassign $nfs_mounts($host) mount_dir shortcut
00259 set shortcut_len [string length $shortcut]
00260 if {[string equal -length $shortcut_len $shortcut $fname]} {
00261 set fname [string replace $fname 0 [expr $shortcut_len - 1] $mount_dir]
00262 }
00263 }
00264 }
00265
00266 return $fname
00267
00268 }
00269
00270 ######################################################################
00271 # Checks to see if the given file is newer than the file within the
00272 # editor. If it is newer, prompt the user to update the file.
00273 proc check_file {index} {
00274
00275 variable files
00276 variable fields
00277
00278 # Get the file information
00279 get_info $index fileindex tab fname mtime modified
00280
00281 if {$fname ne ""} {
00282 if {[exists $index]} {
00283 set file_mtime [modtime $index]
00284 if {$mtime != $file_mtime} {
00285 if {$modified} {
00286 set answer [tk_messageBox -parent . -icon question -message [msgcat::mc "Reload file?"] \
00287 -detail $fname -type yesno -default yes]
00288 if {$answer eq "yes"} {
00289 gui::update_file $index
00290 }
00291 } else {
00292 gui::update_file $index
00293 }
00294 lset files $index $fields(mtime) $file_mtime
00295 }
00296 } elseif {$mtime ne ""} {
00297 set answer [tk_messageBox -parent . -icon question -message [msgcat::mc "Delete tab?"] \
00298 -detail $fname -type yesno -default yes]
00299 if {$answer eq "yes"} {
00300 gui::close_tab $tab -check 0
00301 } else {
00302 lset files $index $fields(mtime) ""
00303 }
00304 }
00305 }
00306
00307 }
00308
00309 ######################################################################
00310 # Adds a new file to the list of opened files.
00311 proc add {fname tab args} {
00312
00313 variable files
00314 variable fields
00315
00316 array set opts [list \
00317 -save_cmd "" \
00318 -lock 0 \
00319 -readonly 0 \
00320 -sidebar 0 \
00321 -buffer 0 \
00322 -gutters [list] \
00323 -diff 0 \
00324 -tags [list] \
00325 -loaded 0 \
00326 -eol "" \
00327 -remember 0 \
00328 -remote "" \
00329 -xview 0 \
00330 -yview 0 \
00331 -cursor 1.0 \
00332 -encode [encoding system] \
00333 ]
00334 array set opts $args
00335
00336 set file_info [lrepeat [array size fields] ""]
00337
00338 lset file_info $fields(fname) $fname
00339 lset file_info $fields(mtime) ""
00340 lset file_info $fields(save_cmd) $opts(-save_cmd)
00341 lset file_info $fields(tab) $tab
00342 lset file_info $fields(lock) $opts(-lock)
00343 lset file_info $fields(readonly) [expr $opts(-readonly) || $opts(-diff)]
00344 lset file_info $fields(sidebar) $opts(-sidebar)
00345 lset file_info $fields(buffer) $opts(-buffer)
00346 lset file_info $fields(modified) 0
00347 lset file_info $fields(gutters) $opts(-gutters)
00348 lset file_info $fields(diff) $opts(-diff)
00349 lset file_info $fields(tags) $opts(-tags)
00350 lset file_info $fields(loaded) $opts(-loaded)
00351 lset file_info $fields(remember) $opts(-remember)
00352 lset file_info $fields(remote) $opts(-remote)
00353 lset file_info $fields(xview) $opts(-xview)
00354 lset file_info $fields(yview) $opts(-yview)
00355 lset file_info $fields(cursor) $opts(-cursor)
00356 lset file_info $fields(encode) $opts(-encode)
00357
00358 if {($opts(-remote) eq "") && !$opts(-buffer) && [file exists $fname]} {
00359 lset file_info $fields(eol) [get_eol_translation $fname]
00360 } else {
00361 lset file_info $fields(eol) [get_eol_translation ""]
00362 }
00363
00364 # Add the file information to the files list
00365 lappend files $file_info
00366
00367 }
00368
00369 ######################################################################
00370 # Close the file associated with the given tab.
00371 proc remove {tab} {
00372
00373 variable files
00374 variable fields
00375
00376 # Get the file index
00377 if {[get_info $tab tab fileindex] != -1} {
00378 set files [lreplace $files $fileindex $fileindex]
00379 }
00380
00381 }
00382
00383 ######################################################################
00384 # gzips the given filename, adding the .gz file extension.
00385 proc gzip {fname} {
00386
00387 set fin [open $file rb]
00388 set header [dict create filename $file time [file mtime $file] comment "Created by Tclinfo patchlevel"]
00389 set fout [open $file.gz wb]
00390 zlib push gzip $fout -header $header
00391 fcopy $fin $fout
00392 close $fin
00393 close $fout
00394
00395 }
00396
00397 ######################################################################
00398 # gunzips the given filename, returning the contents of the file.
00399 proc gunzip {fname} {
00400
00401 # TBD
00402
00403 }
00404
00405 ######################################################################
00406 # Returns the contents of the file located at the given tab. Returns
00407 # a value of 1 if the file was successfully loaded; otherwise, returns
00408 # 0.
00409 proc get_file {tab pcontents} {
00410
00411 variable files
00412 variable fields
00413
00414 get_info $tab tab fileindex fname diff remote encode
00415
00416 # Set the loaded indicator
00417 lset files $fileindex $fields(loaded) 1
00418
00419 upvar $pcontents contents
00420
00421 # Get the file contents
00422 if {$remote ne ""} {
00423 remote::get_file $remote $fname $encode contents modtime
00424 lset files $fileindex $fields(mtime) $modtime
00425 } elseif {![catch { open $fname r } rc]} {
00426 fconfigure $rc -encoding $encode
00427 set contents [string range [read $rc] 0 end-1]
00428 close $rc
00429 lset files $fileindex $fields(mtime) [file mtime $fname]
00430 } else {
00431 return 0
00432 }
00433
00434 return 1
00435
00436 }
00437
00438 ######################################################################
00439 # Saves the contents of the given file contents.
00440 proc set_file {tab contents} {
00441
00442 variable files
00443 variable fields
00444
00445 get_info $tab tab fileindex fname remote eol encode
00446
00447 if {$remote ne ""} {
00448
00449 # Save the file contents to the remote file
00450 if {![remote::save_file $remote $fname $encode $contents modtime]} {
00451 gui::set_error_message [msgcat::mc "Unable to write remote file"] ""
00452 return 0
00453 }
00454
00455 lset files $fileindex $fields(mtime) $modtime
00456
00457 } elseif {![catch { open $fname w } rc]} {
00458
00459 # Write the file contents
00460 catch { fconfigure $rc -translation $eol -encoding $encode }
00461 puts $rc $contents
00462 close $rc
00463
00464 lset files $fileindex $fields(mtime) [file mtime $fname]
00465
00466 } else {
00467
00468 gui::set_error_message [msgcat::mc "Unable to write file"] $rc
00469 return 0
00470
00471 }
00472
00473 return 1
00474
00475 }
00476
00477 ######################################################################
00478 # Save command for new files. Changes buffer into a normal file
00479 # if the file was actually saved.
00480 proc save_new_file {save_as index} {
00481
00482 variable files
00483 variable fields
00484
00485 # Set the buffer state to 0 and clear the save command
00486 if {($save_as ne "") || ([lindex $files $index $fields(fname)] ne "Untitled")} {
00487 lset files $index $fields(buffer) 0
00488 lset files $index $fields(save_cmd) ""
00489 lset files $index $fields(remember) 1
00490 return 1
00491 } elseif {[set save_as [gui::prompt_for_save]] ne ""} {
00492 lset files $index $fields(buffer) 0
00493 lset files $index $fields(save_cmd) ""
00494 lset files $index $fields(fname) $save_as
00495 lset files $index $fields(remember) 1
00496 return 1
00497 }
00498
00499 return -code error "New file was not saved"
00500
00501 }
00502
00503 ######################################################################
00504 # Returns the EOL translation to use for the given file.
00505 proc get_eol_translation {fname} {
00506
00507 set type [expr {($fname eq "") ? "sys" : [preferences::get Editor/EndOfLineTranslation]}]
00508
00509 switch $type {
00510 auto { return [utils::get_eol_char $fname] }
00511 sys { return [expr {($::tcl_platform(platform) eq "windows") ? "crlf" : "lf"}] }
00512 default { return $type }
00513 }
00514
00515 }
00516
00517 ######################################################################
00518 # Move the given folder to the given directory.
00519 proc move_folder {fname remote dir} {
00520
00521 return [rename_folder $fname [file join $dir [file tail $fname]] $remote]
00522
00523 }
00524
00525 ######################################################################
00526 # Renames the given folder to the new name.
00527 proc rename_folder {old_name new_name remote} {
00528
00529 variable files
00530 variable fields
00531
00532 if {$remote eq ""} {
00533
00534 # Normalize the filename
00535 set new_name [file normalize $new_name]
00536
00537 # Allow any plugins to handle the rename
00538 plugins::handle_on_rename $old_name $new_name
00539
00540 if {[catch { file rename -force -- $old_name $new_name } rc]} {
00541 return -code error $rc
00542 }
00543
00544 } else {
00545
00546 # Allow any plugins to handle the rename
00547 plugins::handle_on_rename $old_name $new_name
00548
00549 if {![remote::rename_file $remote $old_name $new_name]} {
00550 return -code error ""
00551 }
00552
00553 }
00554
00555 # If this is a displayed file, update the file information
00556 foreach index [lsearch -all -index $fields(fname) $files $old_name*] {
00557 set old_fname [lindex $files $index $fields(fname)]
00558 lset files $index $fields(fname) "$new_name[string range $old_fname [string length $old_name] end]"
00559 lset files $index $fields(mtime) [modtime $index]
00560 gui::get_info $index fileindex tab
00561 gui::update_tab $tab
00562 }
00563
00564 return $new_name
00565
00566 }
00567
00568 ######################################################################
00569 # Deletes the given folder from the file system.
00570 proc delete_folder {dir remote} {
00571
00572 # Allow any plugins to handle the rename
00573 plugins::handle_on_delete $dir
00574
00575 if {$remote eq ""} {
00576 if {[catch { file delete -force -- $dir } rc]} {
00577 return -code error $rc
00578 }
00579 } else {
00580 if {![remote::remove_directories $remote [list $dir] -force 1]} {
00581 return -code error ""
00582 }
00583 }
00584
00585 # Close any opened files within one of the deleted directories
00586 gui::close_dir_files [list $dir]
00587
00588 }
00589
00590 ######################################################################
00591 # Move the given filename to the given directory.
00592 proc move_file {fname remote dir} {
00593
00594 variable files
00595 variable fields
00596
00597 # Create the new name
00598 set new_name [file join $dir [file tail $fname]]
00599
00600 # Handle the move like a rename
00601 plugins::handle_on_rename $fname $new_name
00602
00603 # Perform the move
00604 if {$remote eq ""} {
00605 if {[catch { file rename -force -- $fname $new_name } rc]} {
00606 return -code error $rc
00607 }
00608 } else {
00609 if {![remote::rename_file $remote $fname $new_name]} {
00610 return -code error ""
00611 }
00612 }
00613
00614 # Find the matching file in the files list and change its filename to the new name
00615 if {[set index [get_index $fname $remote]] != -1} {
00616
00617 # Update the stored name to the new name and modification time
00618 lset files $index $fields(fname) $new_name
00619 lset files $index $fields(mtime) [modtime $index]
00620
00621 # Get some information about the current file
00622 gui::get_info $index fileindex tab
00623
00624 # Update the tab text
00625 gui::update_tab $tab
00626
00627 }
00628
00629 return $new_name
00630
00631 }
00632
00633 ######################################################################
00634 # Performs a file rename.
00635 proc rename_file {old_name new_name remote} {
00636
00637 variable files
00638 variable fields
00639
00640 if {$remote eq ""} {
00641
00642 # Normalize the filename
00643 set new_name [file normalize $new_name]
00644
00645 # Allow any plugins to handle the rename
00646 plugins::handle_on_rename $old_name $new_name
00647
00648 # Perform the rename operation
00649 if {[catch { file rename -force -- $old_name $new_name } rc]} {
00650 return -code error $rc
00651 }
00652
00653 } else {
00654
00655 # Allow any plugins to handle the rename
00656 plugins::handle_on_rename $old_name $new_name
00657
00658 if {![remote::rename_file $remote $old_name $new_name]} {
00659 return -code error ""
00660 }
00661
00662 }
00663
00664 # Find the matching file in the files list and change its filename to the new name
00665 if {[set index [get_index $old_name $remote]] != -1} {
00666
00667 # Update the stored name to the new name and modification time
00668 lset files $index $fields(fname) $new_name
00669 lset files $index $fields(mtime) [modtime $index]
00670
00671 # Get some information about the current file
00672 gui::get_info $index fileindex tab txt lang
00673
00674 # Reset the syntax highlighter to match the new name
00675 if {[set new_lang [syntax::get_default_language $new_name]] ne $lang} {
00676 syntax::set_language $txt $new_lang
00677 }
00678
00679 # Update the tab text
00680 gui::update_tab $tab
00681
00682 }
00683
00684 return $new_name
00685
00686 }
00687
00688 ######################################################################
00689 # Duplicates the given filename.
00690 proc duplicate_file {fname remote} {
00691
00692 # Create the default name of the duplicate file
00693 set dup_fname "[file rootname $fname] Copy[file extension $fname]"
00694 set num 1
00695 if {$remote eq ""} {
00696 while {[file exists $dup_fname]} {
00697 set dup_fname "[file rootname $fname] Copy [incr num][file extension $fname]"
00698 }
00699 if {[catch { file copy $fname $dup_fname } rc]} {
00700 return -code error $rc
00701 }
00702 } else {
00703 while {[remote::file_exists $remote $dup_fname]} {
00704 set dup_fname "[file rootname $fname] Copy [incr num][file extension $fname]"
00705 }
00706 if {![remote::duplicate_file $remote $fname $dup_fname]} {
00707 return -code error ""
00708 }
00709 }
00710
00711 # Allow any plugins to handle the rename
00712 plugins::handle_on_duplicate $fname $dup_fname
00713
00714 return $dup_fname
00715
00716 }
00717
00718 ######################################################################
00719 # Deletes the given file.
00720 proc delete_file {fname remote} {
00721
00722 # Allow any plugins to handle the deletion
00723 plugins::handle_on_delete $fname
00724
00725 if {$remote eq ""} {
00726 if {[catch { file delete -force $fname } rc]} {
00727 return -code error $rc
00728 }
00729 } else {
00730 if {![remote::remove_files $remote [list $fname]]} {
00731 return -code error ""
00732 }
00733 }
00734
00735 # Close the tab associated with this filename
00736 catch { gui::close_files [list $fname] }
00737
00738 }
00739
00740 ######################################################################
00741 # Moves the given file/folder to the trash. If there are any issues,
00742 # we will throw an exception.
00743 proc move_to_trash {fname isdir} {
00744
00745 # Allow any plugins to handle the deletion
00746 plugins::handle_on_trash $fname
00747
00748 # Move the original directory to the trash
00749 switch -glob $::tcl_platform(os) {
00750
00751 Darwin {
00752 set cmd "tell app \"Finder\" to move the POSIX file \"$fname\" to trash"
00753 if {[catch { exec -ignorestderr osascript -e $cmd } rc]} {
00754 return -code error $rc
00755 }
00756 close_tabs $fname $isdir
00757 return
00758 }
00759
00760 Linux* {
00761 if {![catch { exec -ignorestderr which gio 2>@1 }]} {
00762 if {[catch { exec -ignorestderr gio trash $fname } rc]} {
00763 return -code error $rc
00764 }
00765 close_tabs $fname $isdir
00766 return
00767 } elseif {![catch { exec -ignorestderr which gvfs-trash 2>@1 }]} {
00768 if {[catch { exec -ignorestderr gvfs-trash $fname } rc]} {
00769 return -code error $rc
00770 }
00771 close_tabs $fname $isdir
00772 return
00773 } elseif {![catch { exec -ignorestderr which kioclient 2>@1 }]} {
00774 if {[catch { exec -ignorestderr kioclient move $fname trash:/ } rc]} {
00775 return -code error $rc
00776 }
00777 close_tabs $fname $isdir
00778 return
00779 } elseif {[file exists [set trash [file join ~ .local share Trash]]]} {
00780 if {[info exists ::env(XDG_DATA_HOME)] && ($::env(XDG_DATA_HOME) ne "") && [file exists $::env(XDG_DATA_HOME)]} {
00781 set trash $::env(XDG_DATA_HOME)
00782 }
00783 set trash_path [get_unique_path [file join $trash files] [file tail $fname]]
00784 if {![catch { open [file join $trash info [file tail $trash_path].trashinfo] w } rc]} {
00785 puts $rc "\[Trash Info\]"
00786 puts $rc "Path=$fname"
00787 puts $rc "DeletionDate=[clock format [clock seconds] -format {%Y-%m-%dT%T}]"
00788 close $rc
00789 } else {
00790 return -code error $rc
00791 }
00792 } elseif {[file exists [set trash [file join ~ .Trash]]]} {
00793 set trash_path [get_unique_path [file join $trash files] [file tail $fname]]
00794 } else {
00795 return -code error [msgcat::mc "Unable to determine how to move to trash"]
00796 }
00797 }
00798
00799 *Win* {
00800 set binit [file join $::tke_dir Win binit binit.exe]
00801 if {[namespace exists ::freewrap] && [zvfs::exists $binit]} {
00802 if {[catch { exec -ignorestderr [freewrap::unpack $binit] [file normalize $fname] } rc]} {
00803 return -code error $rc
00804 }
00805 close_tabs $fname $isdir
00806 return
00807 } elseif {[file exists $binit]} {
00808 if {[catch { exec -ignorestderr $binit [file normalize $fname] } rc]} {
00809 return -code error $rc
00810 }
00811 close_tabs $fname $isdir
00812 return
00813 } elseif {[file exists [file join C: RECYCLER]]} {
00814 set trash_path [file join C: RECYCLER]
00815 } elseif {[file exists [file join C: {$Recycle.bin}]]} {
00816 set trash_path [file join C: {$Recycle.bin}]
00817 } else {
00818 return -code error [msgcat::mc "Unable to determine how to move to trash"]
00819 }
00820 }
00821
00822 default {
00823 return -code error [msgcat::mc "Unable to determine platform"]
00824 }
00825
00826 }
00827
00828 # Finally, move the file/directory to the trash
00829 if {[catch { file rename -force $fname $trash_path } rc]} {
00830 return -code error $rc
00831 }
00832
00833 # Close the opened tabs
00834 close_tabs $fname $isdir
00835
00836 }
00837
00838 ######################################################################
00839 # PRIVATE PROCEDURES
00840 ######################################################################
00841
00842 ######################################################################
00843 # Returns a unique pathname in the given directory.
00844 proc get_unique_path {dpath fname} {
00845
00846 set path [file join $dpath $fname]
00847 set index 0
00848 while {[file exists $path]} {
00849 set path [file join $dpath "$fname ([incr index])"]
00850 }
00851
00852 return [file normalize $path]
00853
00854 }
00855
00856 ######################################################################
00857 # Closes any tabs associated with the directory/file.
00858 proc close_tabs {fname isdir} {
00859
00860 # Close all of the deleted files from the UI
00861 if {$isdir} {
00862 gui::close_dir_files [list $fname]
00863 } else {
00864 gui::close_files [list $fname]
00865 }
00866
00867 }
00868
00869 }
