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 }