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: sidebar.tcl 00020 # Author: Trevor Williams (phase1geo@gmail.com) 00021 # Date: 10/03/2013 00022 # Brief: Handles the UI and related functionality associated with the 00023 # sidebar. 00024 ###################################################################### 00025 00026 namespace eval sidebar { 00027 00028 variable last_opened {} 00029 variable selection_anchor "" 00030 variable last_id "" 00031 variable after_id "" 00032 variable jump_str "" 00033 variable jump_after_id "" 00034 variable select_id "" 00035 variable sortby "name" 00036 variable sortdir "-increasing" 00037 variable spring_id "" 00038 variable tkdnd_id "" 00039 variable tkdnd_drag 0 00040 variable state "normal" 00041 variable ipanel_id "" 00042 00043 array set widgets {} 00044 array set scan_id { 00045 up "" 00046 down "" 00047 } 00048 00049 ###################################################################### 00050 # Returns a list containing information that the sidebar will save to the 00051 # session file. 00052 proc save_session {} { 00053 00054 variable widgets 00055 variable last_opened 00056 00057 set dirs [list] 00058 foreach child [$widgets(tl) children ""] { 00059 if {[$widgets(tl) set $child remote] eq ""} { 00060 lappend dirs [list name [$widgets(tl) set $child name]] 00061 } 00062 } 00063 00064 return [list directories $dirs last_opened $last_opened opened_dirs [get_opened_dirs]] 00065 00066 } 00067 00068 ###################################################################### 00069 # Loads the given information into the sidebar from the session file. 00070 proc load_session {data} { 00071 00072 variable widgets 00073 variable last_opened 00074 00075 # Get the session information 00076 array set content { 00077 directories {} 00078 last_opened {} 00079 opened_dirs {} 00080 } 00081 array set content $data 00082 00083 # Add the last_opened directories to the saved list 00084 set last_opened $content(last_opened) 00085 00086 # Add the session directories (if the sidebar is currently empty) 00087 if {[llength [$widgets(tl) children ""]] == 0} { 00088 foreach dir_list $content(directories) { 00089 array set dir $dir_list 00090 add_directory $dir(name) 00091 } 00092 } 00093 00094 # Make sure all of the appropriate directories are opened 00095 foreach name $content(opened_dirs) { 00096 if {[set row [$widgets(tl) tag has $name,]] ne ""} { 00097 expand_directory $row 00098 } 00099 } 00100 00101 } 00102 00103 ###################################################################### 00104 # Returns the current width of the sidebar. 00105 proc get_width {} { 00106 00107 variable widgets 00108 00109 return [expr [$widgets(tl) column #0 -width] - 4] 00110 00111 } 00112 00113 ###################################################################### 00114 # Sets the state of the sidebar to the given value. The legal values 00115 # are: normal, disabled, viewonly. 00116 proc set_state {value} { 00117 00118 variable widgets 00119 variable state 00120 00121 switch $state { 00122 normal - 00123 viewonly { $widgets(tl) state !disabled } 00124 disabled { $widgets(tl) state disabled } 00125 default { 00126 return -code error "Attempting to set sidebar state to an unsupported value ($value)" 00127 } 00128 } 00129 00130 set state $value 00131 00132 } 00133 00134 ###################################################################### 00135 # Returns a list containing 00136 proc get_opened_dirs {} { 00137 00138 variable widgets 00139 00140 set dirs [list] 00141 00142 foreach dir [$widgets(tl) tag has d] { 00143 if {([$widgets(tl) set $dir remote] eq "") && [$widgets(tl) item $dir -open]} { 00144 lappend dirs [$widgets(tl) set $dir name] 00145 } 00146 } 00147 00148 return $dirs 00149 00150 } 00151 00152 ###################################################################### 00153 # Adds the given directory to the list of most recently opened directories. 00154 proc add_to_recently_opened {sdir} { 00155 00156 variable last_opened 00157 00158 if {[set index [lsearch $last_opened $sdir]] != -1} { 00159 set last_opened [lreplace $last_opened $index $index] 00160 } 00161 00162 set last_opened [lrange [list $sdir {*}$last_opened] 0 20] 00163 00164 } 00165 00166 ###################################################################### 00167 # Returns the list of last opened directories. 00168 proc get_last_opened {} { 00169 00170 variable last_opened 00171 00172 return $last_opened 00173 00174 } 00175 00176 ###################################################################### 00177 # Clears the last opened directory list. 00178 proc clear_last_opened {} { 00179 00180 variable last_opened 00181 00182 set last_opened [list] 00183 00184 } 00185 00186 ###################################################################### 00187 # Creates the sidebar UI and initializes it. 00188 proc create {w} { 00189 00190 variable widgets 00191 00192 # Create needed images 00193 theme::register_image sidebar_open bitmap sidebar -background \ 00194 {msgcat::mc "Image displayed in sidebar to indicate that a file is currently opened in an editing buffer."} \ 00195 -file [file join $::tke_dir lib images sopen.bmp] \ 00196 -maskfile [file join $::tke_dir lib images smask.bmp] \ 00197 -foreground gold -background black 00198 00199 theme::register_image sidebar_hidden bitmap sidebar -background \ 00200 {msgcat::mc "Image displayed in sidebar to indicate that a file is currently opened but hidden"} \ 00201 -file [file join $::tke_dir lib images sopen.bmp] \ 00202 -maskfile [file join $::tke_dir lib images smask.bmp] \ 00203 -foreground white -background black 00204 00205 theme::register_image sidebar_file bitmap sidebar -background \ 00206 {msgcat::mc "Image displayed in sidebar to indicate a file"} \ 00207 -file [file join $::tke_dir lib images blank10.bmp] \ 00208 -maskfile [file join $::tke_dir lib images blank10.bmp] \ 00209 -foreground 1 00210 00211 theme::register_image sidebar_expanded bitmap sidebar -background \ 00212 {msgcat::mc "Image displayed in sidebar to indicate a directory that is showing its contents"} \ 00213 -file [file join $::tke_dir lib images down10.bmp] \ 00214 -maskfile [file join $::tke_dir lib images down10.bmp] \ 00215 -foreground 1 00216 00217 theme::register_image sidebar_collapsed bitmap sidebar -background \ 00218 {msgcat::mc "Image displayed in sidebar to indicate a directory that is collapsed"} \ 00219 -file [file join $::tke_dir lib images right10.bmp] \ 00220 -maskfile [file join $::tke_dir lib images right10.bmp] \ 00221 -foreground 1 00222 00223 theme::register_image sidebar_expanded_sel bitmap sidebar -selectbackground \ 00224 {msgcat::mc "Image displayed in sidebar to indicate a selected directory that is expanded"} \ 00225 -file [file join $::tke_dir lib images down10.bmp] \ 00226 -maskfile [file join $::tke_dir lib images down10.bmp] \ 00227 -foreground 2 00228 00229 theme::register_image sidebar_collapsed_sel bitmap sidebar -selectbackground \ 00230 {msgcat::mc "Image displayed in sidebar to indicate a selected directory that is collapsed"} \ 00231 -file [file join $::tke_dir lib images right10.bmp] \ 00232 -maskfile [file join $::tke_dir lib images right10.bmp] \ 00233 -foreground 2 00234 00235 theme::register_image sidebar_info_close bitmap sidebar -background \ 00236 {msgcat::mc "Image displayed in sidebar information panel for closing the panel"} \ 00237 -file [file join $::tke_dir lib images close.bmp] \ 00238 -maskfile [file join $::tke_dir lib images close.bmp] \ 00239 -foreground 1 00240 00241 theme::register_image sidebar_info_refresh bitmap sidebar -background \ 00242 {msgcat::mc "Image displayed in sidebar information panel for refreshing content"} \ 00243 -file [file join $::tke_dir lib images refresh.bmp] \ 00244 -maskfile [file join $::tke_dir lib images refresh.bmp] \ 00245 -foreground 1 00246 00247 theme::register_image sidebar_info_show bitmap sidebar -background \ 00248 {msgcat::mc "Image displayed in sidebar information panel for showing file in sidebar"} \ 00249 -file [file join $::tke_dir lib images show.bmp] \ 00250 -maskfile [file join $::tke_dir lib images show.bmp] \ 00251 -foreground 1 00252 00253 set fg [utils::get_default_foreground] 00254 set bg [utils::get_default_background] 00255 00256 frame $w 00257 00258 # Create the top-level frame 00259 set widgets(frame) [frame $w.tf -highlightthickness 1 -highlightbackground $bg -highlightcolor $bg] 00260 00261 # Add the file tree elements 00262 ttk::frame $w.tf.tf -style SBFrame -padding {3 3 0 0} 00263 pack [set widgets(tl) \ 00264 [ttk::treeview $w.tf.tf.tl -style SBTreeview -columns {name remote sortby} -displaycolumns {} \ 00265 -show tree -yscrollcommand "utils::set_yscrollbar $w.tf.vb"]] -fill both -expand yes 00266 set widgets(sb) [scroller::scroller $w.tf.vb -orient vertical -foreground $fg -background $bg -command [list $widgets(tl) yview]] 00267 set widgets(insert) [frame $widgets(tl).ins -background black -height 2] 00268 00269 $widgets(tl) column #0 -width [preferences::get Sidebar/DefaultWidth] -minwidth 100 00270 00271 set tkdnd_press_cmd "" 00272 set tkdnd_motion_cmd "" 00273 00274 # Make ourselves a drop target (if Tkdnd is available) 00275 catch { 00276 00277 # Register ourselves as a drop target 00278 tkdnd::drop_target register $widgets(tl) DND_Files 00279 00280 bind $widgets(tl) <<DropEnter>> [list sidebar::handle_drop_enter_or_pos %W %X %Y %a %b] 00281 bind $widgets(tl) <<DropPosition>> [list sidebar::handle_drop_enter_or_pos %W %X %Y %a %b] 00282 bind $widgets(tl) <<DropLeave>> [list sidebar::handle_drop_leave %W] 00283 bind $widgets(tl) <<Drop>> [list sidebar::handle_drop %W %A %D] 00284 00285 # Register ourselves as a drag source 00286 tkdnd::drag_source register $widgets(tl) DND_Files 00287 00288 bind $widgets(tl) <<DragInitCmd>> [list sidebar::handle_drag_init %W] 00289 bind $widgets(tl) <<DragEndCmd>> [list sidebar::handle_drag_end %W %A] 00290 00291 # We need to handle some things differently since we do file moves in the sidebar 00292 set tkdnd_press_cmd [bind TkDND_Drag1 <ButtonPress-1>] 00293 set tkdnd_motion_cmd [bind TkDND_Drag1 <B1-Motion>] 00294 00295 # Remove the TkDND_Drag1 binding from the sidebar bindtags 00296 set index [lsearch [bindtags $widgets(tl)] TkDND_Drag1] 00297 bindtags $widgets(tl) [lreplace [bindtags $widgets(tl)] $index $index] 00298 00299 } 00300 00301 bind $widgets(tl) <<TreeviewSelect>> [list sidebar::handle_selection] 00302 bind $widgets(tl) <<TreeviewOpen>> [list sidebar::expand_directory] 00303 bind $widgets(tl) <<TreeviewClose>> [list sidebar::collapse_directory] 00304 bind $widgets(tl) <ButtonPress-1> "if {\[sidebar::handle_left_press %W %x %y [list $tkdnd_press_cmd]\]} break" 00305 bind $widgets(tl) <ButtonRelease-1> [list sidebar::handle_left_release %W %x %y] 00306 bind $widgets(tl) <Control-Button-1> "sidebar::handle_control_left_click %W %x %y; break" 00307 bind $widgets(tl) <Control-Button-$::right_click> [list sidebar::handle_control_right_click %W %x %y] 00308 bind $widgets(tl) <Shift-ButtonPress-1> [list sidebar::do_nothing] 00309 bind $widgets(tl) <Shift-ButtonRelease-1> [list sidebar::do_nothing] 00310 bind $widgets(tl) <Button-$::right_click> [list sidebar::handle_right_click %W %x %y] 00311 bind $widgets(tl) <Double-Button-1> [list sidebar::handle_double_click %W %x %y] 00312 bind $widgets(tl) <Motion> [list sidebar::handle_motion %W %x %y] 00313 bind $widgets(tl) <B1-Motion> [list sidebar::handle_b1_motion %W %x %y $tkdnd_motion_cmd] 00314 bind $widgets(tl) <Control-Return> [list sidebar::handle_control_return_space %W] 00315 bind $widgets(tl) <Control-Key-space> [list sidebar::handle_control_return_space %W] 00316 bind $widgets(tl) <Escape> [list sidebar::handle_escape %W] 00317 bind $widgets(tl) <Return> { 00318 sidebar::handle_return_space %W 00319 break 00320 } 00321 bind $widgets(tl) <Key-space> { 00322 sidebar::handle_return_space %W 00323 break 00324 } 00325 bind $widgets(tl) <BackSpace> { 00326 sidebar::handle_backspace %W 00327 break 00328 } 00329 bind $widgets(tl) <Key> [list sidebar::handle_any %K %A] 00330 bind $widgets(tl) <FocusIn> [list sidebar::handle_focus_in] 00331 bind $widgets(tl) <FocusOut> [list sidebar::handle_focus_out] 00332 bind $widgets(tl) <Alt-Up> "sidebar::handle_move_up; break" 00333 bind $widgets(tl) <Alt-Down> "sidebar::handle_move_down; break" 00334 00335 grid rowconfigure $w.tf 0 -weight 1 00336 grid columnconfigure $w.tf 0 -weight 1 00337 grid $w.tf.tf -row 0 -column 0 -sticky news 00338 grid $w.tf.vb -row 0 -column 1 -sticky ns 00339 00340 pack $w.tf -fill both -expand yes 00341 00342 # Create sidebar info panel user interface 00343 set widgets(info) [frame $w.if] 00344 set widgets(info,psep1) [ttk::separator $w.if.psep1] 00345 set widgets(info,panel) [ipanel::create $w.if.panel -closecmd sidebar::close_info_panel -showcmd sidebar::view_file] 00346 set widgets(info,psep2) [ttk::separator $w.if.psep2] 00347 00348 bind $widgets(info,panel) <<ThemeChange>> [list sidebar::panel_theme_change %d] 00349 00350 grid rowconfigure $widgets(info) 1 -weight 1 00351 grid columnconfigure $widgets(info) 0 -weight 1 00352 grid $widgets(info,psep1) -row 0 -column 0 -sticky ew 00353 grid $widgets(info,panel) -row 1 -column 0 -sticky news 00354 grid $widgets(info,psep2) -row 2 -column 0 -sticky ew 00355 00356 # Create directory popup 00357 set widgets(menu) [menu $w.popupMenu -tearoff 0 -postcommand "sidebar::menu_post"] 00358 set widgets(sortmenu) [menu $w.popupMenu.sortbyMenu -tearoff 0 -postcommand "sidebar::sort_menu_post"] 00359 00360 # Setup the sort menu 00361 setup_sort_menu 00362 00363 # Register the sidebar and sidebar scrollbar for theming purposes 00364 theme::register_widget $widgets(tl) sidebar 00365 theme::register_widget $widgets(sb) sidebar_scrollbar 00366 theme::register_widget $widgets(menu) menus 00367 theme::register_widget $widgets(sortmenu) menus 00368 00369 # Handle traces 00370 trace variable preferences::prefs(Sidebar/IgnoreFilePatterns) w sidebar::handle_ignore_files 00371 trace variable preferences::prefs(Sidebar/IgnoreBinaries) w sidebar::handle_ignore_files 00372 trace variable preferences::prefs(Sidebar/InfoPanelAttributes) w sidebar::handle_info_panel_view 00373 trace variable preferences::prefs(Sidebar/InfoPanelFollowsSelection) w sidebar::handle_info_panel_follows 00374 00375 return $w 00376 00377 } 00378 00379 ###################################################################### 00380 # Does just what the name suggests. Used by sidebar bindings. 00381 proc do_nothing {} {} 00382 00383 ###################################################################### 00384 # Called when the panel theme changes. Takes care to show/hide the 00385 # information panel divider widgets based on colors. 00386 proc panel_theme_change {panel_color} { 00387 00388 variable widgets 00389 00390 array set ttk_opts [theme::get_category_options ttk_style 1] 00391 array set sidebar_opts [theme::get_category_options sidebar 1] 00392 00393 if {$panel_color eq $sidebar_opts(-background)} { 00394 grid $widgets(info,psep1) 00395 } else { 00396 grid remove $widgets(info,psep1) 00397 } 00398 00399 if {$panel_color eq $ttk_opts(background)} { 00400 grid $widgets(info,psep2) 00401 } else { 00402 grid remove $widgets(info,psep2) 00403 } 00404 00405 } 00406 00407 ###################################################################### 00408 # Sets the row's image and adjusts the text to provide a gap between 00409 # the image and the text. 00410 proc set_image {row img} { 00411 00412 variable widgets 00413 00414 # Get the item's name 00415 set name [string trim [$widgets(tl) item $row -text]] 00416 00417 if {$img eq ""} { 00418 $widgets(tl) item $row -image $img -text $name 00419 } else { 00420 $widgets(tl) item $row -image $img -text " $name" 00421 } 00422 00423 } 00424 00425 ###################################################################### 00426 # Clears the sidebar of all content. This is primarily called when 00427 # we are switching sessions. 00428 proc clear {} { 00429 00430 variable widgets 00431 00432 $widgets(tl) delete [$widgets(tl) children {}] 00433 00434 } 00435 00436 ###################################################################### 00437 # Returns true if the current selection (if it exists) can be manually 00438 # moved. 00439 proc is_selection_movable {} { 00440 00441 variable widgets 00442 00443 # If nothing is currently selected, do nothing 00444 if {[set selected [$widgets(tl) selection]] eq ""} { 00445 return 0 00446 } 00447 00448 # Verify that all selected lines belong to the same parent 00449 set parent [$widgets(tl) parent [lindex $selected 0]] 00450 foreach item [lrange $selected 1 end] { 00451 if {[$widgets(tl) parent $item] ne $parent} { 00452 return 0 00453 } 00454 } 00455 00456 # Verify that the parent is set to manually sort 00457 if {[$widgets(tl) set $parent sortby] ne "manual"} { 00458 return 0 00459 } 00460 00461 return 1 00462 00463 } 00464 00465 ###################################################################### 00466 # Moves the currently selected lines (if applicable) up by one. 00467 proc handle_move_up {} { 00468 00469 variable widgets 00470 00471 # If the selection cannot be moved, return immediately 00472 if {![is_selection_movable]} { 00473 return 00474 } 00475 00476 foreach item [$widgets(tl) selection] { 00477 set index [$widgets(tl) index $item] 00478 if {$index == 0} { 00479 return 00480 } 00481 $widgets(tl) move $item [$widgets(tl) parent $item] [expr $index - 1] 00482 } 00483 00484 } 00485 00486 ###################################################################### 00487 # Moves the currently selected lines (if applicable) down by one. 00488 proc handle_move_down {} { 00489 00490 variable widgets 00491 00492 # If the selection cannot be moved, return immediately 00493 if {![is_selection_movable]} { 00494 return 00495 } 00496 00497 foreach item [lreverse [$widgets(tl) selection]] { 00498 set parent [$widgets(tl) parent $item] 00499 set index [$widgets(tl) index $item] 00500 if {($index + 1) == [llength [$widgets(tl) children $parent]]} { 00501 break 00502 } 00503 $widgets(tl) move $item $parent [expr $index + 1] 00504 } 00505 00506 } 00507 00508 ###################################################################### 00509 # Handles a drag-and-drop enter/position event. Draws UI to show that 00510 # the file drop request would be excepted or rejected. 00511 proc handle_drop_enter_or_pos {tbl rootx rooty actions buttons} { 00512 00513 variable tkdnd_drag 00514 00515 # If we are dragging from ourselves, don't change the highlight color 00516 if {$tkdnd_drag} { 00517 return "refuse_drop" 00518 } 00519 00520 array set opts [theme::get_category_options sidebar 1] 00521 00522 [winfo parent [winfo parent $tbl]] configure -highlightbackground $opts(-dropcolor) 00523 00524 return "link" 00525 00526 } 00527 00528 ###################################################################### 00529 # Handles a drop leave event. 00530 proc handle_drop_leave {tbl} { 00531 00532 array set opts [theme::get_category_options sidebar 1] 00533 00534 [winfo parent [winfo parent $tbl]] configure -highlightbackground $opts(-highlightbackground) 00535 00536 } 00537 00538 ###################################################################### 00539 # Handles a drop event. Adds the given files/directories to the sidebar. 00540 proc handle_drop {tbl action files} { 00541 00542 variable tkdnd_drag 00543 variable state 00544 00545 # If we are dragging to ourselves, do nothing 00546 if {$tkdnd_drag} { 00547 set tkdnd_drag 0 00548 return 00549 } 00550 00551 foreach fname $files { 00552 if {[file isdirectory $fname]} { 00553 add_directory $fname 00554 } elseif {($state eq "normal") && ![::check_file_for_import $fname]} { 00555 gui::add_file end $fname 00556 } 00557 } 00558 00559 handle_drop_leave $tbl 00560 00561 return "link" 00562 00563 } 00564 00565 ###################################################################### 00566 # Perform the TkDND button-1 press event. 00567 proc tkdnd_press {cmd args} { 00568 00569 variable tkdnd_id 00570 00571 set tkdnd_id [after 1000 [list sidebar::tkdnd_call_press $cmd {*}$args]] 00572 00573 } 00574 00575 ###################################################################### 00576 # Call the tkdnd press command. 00577 proc tkdnd_call_press {cmd args} { 00578 00579 variable widgets 00580 00581 set sel_fg [$widgets(tl) tag configure sel -foreground] 00582 set sel_bg [$widgets(tl) tag configure sel -background] 00583 set fg [$widgets(tl) tag configure moveto -foreground] 00584 set bg [$widgets(tl) tag configure moveto -background] 00585 00586 # Blink the selection so the user knows when we can drag the selection 00587 $widgets(tl) tag configure sel -foreground $fg -background $bg 00588 00589 after 100 [list sidebar::tkdnd_call_press2 $cmd $args $sel_fg $sel_bg] 00590 00591 } 00592 00593 ###################################################################### 00594 # Call the tkdnd press command. 00595 proc tkdnd_call_press2 {cmd opts fg bg} { 00596 00597 variable widgets 00598 variable tkdnd_id 00599 variable tkdnd_drag 00600 00601 # Clear the ID 00602 set tkdnd_id "" 00603 set tkdnd_drag 1 00604 00605 $widgets(tl) tag configure sel -foreground $fg -background $bg 00606 00607 # Execute the command 00608 uplevel #0 [list $cmd {*}$opts] 00609 00610 } 00611 00612 ###################################################################### 00613 # Perform the TkDND button-1 motion event. 00614 proc tkdnd_motion {cmd args} { 00615 00616 variable tkdnd_id 00617 00618 # Cancel the button press event 00619 if {$tkdnd_id ne ""} { 00620 after cancel $tkdnd_id 00621 set tkdnd_id "" 00622 } 00623 00624 # Execute the TkDND command 00625 uplevel #0 [list $cmd {*}$args] 00626 00627 } 00628 00629 ###################################################################### 00630 # Perform the TkDND button-1 release. 00631 proc tkdnd_release {} { 00632 00633 variable tkdnd_id 00634 00635 # Cancel the button press event 00636 if {$tkdnd_id ne ""} { 00637 after cancel $tkdnd_id 00638 set tkdnd_id "" 00639 } 00640 00641 } 00642 00643 ###################################################################### 00644 # Called when the user attempts to drag items from the sidebar. 00645 proc handle_drag_init {w} { 00646 00647 # Figure out the file that the user has 00648 set files [list] 00649 foreach item [$w selection] { 00650 if {[$w set $item remote] eq ""} { 00651 lappend files [$w set $item name] 00652 } 00653 } 00654 00655 return [list {copy move link} DND_Files $files] 00656 00657 } 00658 00659 ###################################################################### 00660 # Handle the end of drag event, if the action was a move event, update 00661 # the sidebar state. 00662 proc handle_drag_end {w action} { 00663 00664 variable tkdnd_drag 00665 00666 # End the sidebar drag/drop tracking 00667 set tkdnd_drag 0 00668 00669 # Update the directories containing the selected files 00670 foreach item [$w selection] { 00671 set dirs([file dirname [$w set $item name]]) [$w parent $item] 00672 } 00673 00674 # Reload the unique directories 00675 foreach {dir item} [array get dirs] { 00676 expand_directory $item 00677 } 00678 00679 } 00680 00681 ###################################################################### 00682 # Hides the given scrollbar. 00683 proc hide_scrollbar {} { 00684 00685 variable widgets 00686 00687 # Set the yscrollcommand to the normal kind 00688 $widgets(tl) configure -yscrollcommand "$widgets(sb) set" 00689 00690 # Hide the sidebar 00691 grid remove $widgets(sb) 00692 00693 } 00694 00695 ###################################################################### 00696 # Unhides the given scrollbar (if it needs to be displayed). 00697 proc unhide_scrollbar {} { 00698 00699 variable widgets 00700 00701 # Set the yscrollcommand to the auto-hide version 00702 $widgets(tl) configure -yscrollcommand "utils::set_yscrollbar $widgets(sb)" 00703 00704 # Run the set_yscrollbar command 00705 if {[llength [set sb_get [$widgets(sb) get]]] == 2} { 00706 utils::set_yscrollbar $widgets(sb) {*}$sb_get 00707 } 00708 00709 } 00710 00711 ###################################################################### 00712 # Returns "root", "dir" or "file" to indicate what type of item is 00713 # specified at the given row in the sidebar table. 00714 proc row_type {row} { 00715 00716 variable widgets 00717 00718 if {[$widgets(tl) parent $row] eq ""} { 00719 return "root" 00720 } elseif {[$widgets(tl) tag has d $row]} { 00721 return "dir" 00722 } else { 00723 return "file" 00724 } 00725 00726 } 00727 00728 ###################################################################### 00729 # Returns a value of 1 if row1 is found before row2 in the treeview; 00730 # otherwise, returns a value of 0. 00731 proc row_before {row1 row2} { 00732 00733 variable widgets 00734 00735 return [row_before_helper $widgets(tl) $row1 $row2 {}] 00736 00737 } 00738 00739 ###################################################################### 00740 # Helper procedure for the row_before procedure. 00741 proc row_before_helper {tl row1 row2 item} { 00742 00743 if {$item eq $row1} { return 1 } 00744 if {$item eq $row2} { return 0 } 00745 00746 foreach child [$tl children $item] { 00747 if {[set status [row_before_helper $tl $row1 $row2 $child]] != -1} { 00748 return $status 00749 } 00750 } 00751 00752 return -1 00753 00754 } 00755 00756 ###################################################################### 00757 # Handles the contents of the sidebar popup menu prior to it being posted. 00758 proc menu_post {} { 00759 00760 variable widgets 00761 variable selection_anchor 00762 00763 # Get the current index 00764 switch [row_type $selection_anchor] { 00765 "root" { setup_root_menu [$widgets(tl) selection] } 00766 "dir" { setup_dir_menu [$widgets(tl) selection] } 00767 "file" { setup_file_menu [$widgets(tl) selection] } 00768 } 00769 00770 } 00771 00772 ###################################################################### 00773 # Handles the contents of the sort popup menu prior to it being posted. 00774 proc sort_menu_post {} { 00775 00776 variable widgets 00777 variable selection_anchor 00778 variable sortby 00779 variable sortdir 00780 00781 if {[set sortby [$widgets(tl) set $selection_anchor sortby]] eq "manual"} { 00782 $widgets(sortmenu) entryconfigure [msgcat::mc "Increasing"] -state disabled 00783 $widgets(sortmenu) entryconfigure [msgcat::mc "Decreasing"] -state disabled 00784 } else { 00785 lassign [split $sortby :] sortby sortdir 00786 $widgets(sortmenu) entryconfigure [msgcat::mc "Increasing"] -state normal 00787 $widgets(sortmenu) entryconfigure [msgcat::mc "Decreasing"] -state normal 00788 } 00789 00790 } 00791 00792 ###################################################################### 00793 # Return a list of menu states to use for directories. The returned 00794 # list is: <open_state> <close_state> <hide_state> <show_state> 00795 proc get_menu_states {rows} { 00796 00797 variable widgets 00798 variable state 00799 00800 set opened "disabled" 00801 set closed "disabled" 00802 set hide "disabled" 00803 set show "disabled" 00804 00805 if {$state eq "normal"} { 00806 foreach row $rows { 00807 foreach child [$widgets(tl) children $row] { 00808 switch [$widgets(tl) item $child -image] { 00809 "sidebar_hidden" { set closed "normal"; set show "normal" } 00810 "sidebar_open" { set closed "normal"; set hide "normal" } 00811 default { set opened "normal" } 00812 } 00813 } 00814 } 00815 } 00816 00817 return [list $opened $closed $hide $show] 00818 00819 } 00820 00821 ###################################################################### 00822 # Sets up the popup menu to be suitable for the given directory. 00823 proc setup_dir_menu {rows} { 00824 00825 variable widgets 00826 variable state 00827 00828 set one_state [expr {([llength $rows] == 1) ? "normal" : "disabled"}] 00829 set one_act_state [expr {($state eq "normal") ? $one_state : "disabled"}] 00830 set act_state [expr {($state eq "normal") ? "normal" : "disabled"}] 00831 set fav_state $one_act_state 00832 set sort_state $one_act_state 00833 set first_row [lindex $rows 0] 00834 set remote_found 0 00835 00836 lassign [get_menu_states $rows] open_state close_state hide_state show_state 00837 00838 foreach row $rows { 00839 if {[$widgets(tl) set $row remote] ne ""} { 00840 set fav_state "disabled" 00841 set remote_found 1 00842 break 00843 } 00844 } 00845 foreach row $rows { 00846 if {[$widgets(tl) item $row -open] == 0} { 00847 set sort_state "disabled" 00848 break 00849 } 00850 } 00851 00852 # Clear the menu 00853 plugins::delete_from_menu $widgets(menu) 00854 $widgets(menu) delete 0 end 00855 00856 $widgets(menu) add command -label [msgcat::mc "New File"] -command [list sidebar::add_file_to_folder $first_row] -state $one_act_state 00857 $widgets(menu) add command -label [msgcat::mc "New File From Template"] -command [list sidebar::add_file_from_template $first_row] -state $one_act_state 00858 $widgets(menu) add command -label [msgcat::mc "New Directory"] -command [list sidebar::add_folder_to_folder $first_row] -state $one_act_state 00859 $widgets(menu) add separator 00860 00861 $widgets(menu) add command -label [msgcat::mc "Open Directory Files"] -command [list sidebar::open_folder_files $rows] -state $open_state 00862 $widgets(menu) add command -label [msgcat::mc "Close Directory Files"] -command [list sidebar::close_folder_files $rows] -state $close_state 00863 $widgets(menu) add separator 00864 00865 $widgets(menu) add command -label [msgcat::mc "Hide Directory Files"] -command [list sidebar::hide_folder_files $rows] -state $hide_state 00866 $widgets(menu) add command -label [msgcat::mc "Show Directory Files"] -command [list sidebar::show_folder_files $rows] -state $show_state 00867 $widgets(menu) add separator 00868 00869 $widgets(menu) add command -label [msgcat::mc "Copy Pathname"] -command [list sidebar::copy_pathname $first_row] -state $one_state 00870 $widgets(menu) add command -label [msgcat::mc "Show Info"] -command [list sidebar::update_info_panel $first_row] -state $one_state 00871 $widgets(menu) add separator 00872 $widgets(menu) add command -label [msgcat::mc "Rename"] -command [list sidebar::rename_folder $first_row] -state $one_act_state 00873 if {[preferences::get General/UseMoveToTrash] && !$remote_found} { 00874 $widgets(menu) add command -label [msgcat::mc "Move To Trash"] -command [list sidebar::move_to_trash $rows] -state $act_state 00875 } else { 00876 $widgets(menu) add command -label [msgcat::mc "Delete"] -command [list sidebar::delete_folder $rows] -state $act_state 00877 } 00878 $widgets(menu) add separator 00879 00880 if {[favorites::is_favorite [$widgets(tl) set $first_row name]]} { 00881 $widgets(menu) add command -label [msgcat::mc "Unfavorite"] -command [list sidebar::unfavorite $first_row] -state $fav_state 00882 } else { 00883 $widgets(menu) add command -label [msgcat::mc "Favorite"] -command [list sidebar::favorite $first_row] -state $fav_state 00884 } 00885 $widgets(menu) add separator 00886 00887 $widgets(menu) add command -label [msgcat::mc "Remove from Sidebar"] -command [list sidebar::remove_folder $rows] 00888 $widgets(menu) add command -label [msgcat::mc "Remove Parent from Sidebar"] -command [list sidebar::remove_parent_folder $first_row] -state $one_state 00889 $widgets(menu) add separator 00890 $widgets(menu) add command -label [msgcat::mc "Make Current Working Directory"] -command [list sidebar::set_current_working_directory $first_row] -state $fav_state 00891 $widgets(menu) add command -label [msgcat::mc "Refresh Directory Files"] -command [list sidebar::refresh_directory_files $rows] 00892 $widgets(menu) add separator 00893 00894 $widgets(menu) add cascade -label [msgcat::mc "Sort"] -menu $widgets(sortmenu) -state $sort_state 00895 00896 # Add plugins to sidebar directory popup 00897 plugins::handle_dir_popup $widgets(menu) 00898 00899 } 00900 00901 ###################################################################### 00902 # Sets up the given menu for a root directory item. 00903 proc setup_root_menu {rows} { 00904 00905 variable widgets 00906 variable state 00907 00908 set one_state [expr {([llength $rows] == 1) ? "normal" : "disabled"}] 00909 set one_act_state [expr {($state eq "normal") ? $one_state : "disabled"}] 00910 set act_state [expr {($state eq "normal") ? "normal" : "disabled"}] 00911 set fav_state $one_act_state 00912 set parent_state $one_state 00913 set sort_state $one_act_state 00914 set first_row [lindex $rows 0] 00915 set remote_found 0 00916 00917 lassign [get_menu_states $rows] open_state close_state hide_state show_state 00918 00919 foreach row $rows { 00920 if {[$widgets(tl) set $row remote] ne ""} { 00921 set fav_state "disabled" 00922 set remote_found 1 00923 break 00924 } 00925 } 00926 foreach row $rows { 00927 if {[file tail [$widgets(tl) set $row name]] eq ""} { 00928 set parent_state "disabled" 00929 break 00930 } 00931 } 00932 foreach row $rows { 00933 if {[$widgets(tl) item $row -open] == 0} { 00934 set sort_state "disabled" 00935 break 00936 } 00937 } 00938 00939 # Clear the menu 00940 plugins::delete_from_menu $widgets(menu) 00941 $widgets(menu) delete 0 end 00942 00943 $widgets(menu) add command -label [msgcat::mc "New File"] -command [list sidebar::add_file_to_folder $first_row] -state $one_act_state 00944 $widgets(menu) add command -label [msgcat::mc "New File From Template"] -command [list sidebar::add_file_from_template $first_row] -state $one_act_state 00945 $widgets(menu) add command -label [msgcat::mc "New Directory"] -command [list sidebar::add_folder_to_folder $first_row] -state $one_act_state 00946 $widgets(menu) add separator 00947 00948 $widgets(menu) add command -label [msgcat::mc "Open Directory Files"] -command [list sidebar::open_folder_files $rows] -state $open_state 00949 $widgets(menu) add command -label [msgcat::mc "Close Directory Files"] -command [list sidebar::close_folder_files $rows] -state $close_state 00950 $widgets(menu) add separator 00951 00952 if {$remote_found} { 00953 $widgets(menu) add command -label [msgcat::mc "Disconnect From Server"] -command [list sidebar::disconnect $rows] 00954 $widgets(menu) add separator 00955 } 00956 00957 $widgets(menu) add command -label [msgcat::mc "Hide Directory Files"] -command [list sidebar::hide_folder_files $rows] -state $hide_state 00958 $widgets(menu) add command -label [msgcat::mc "Show Directory Files"] -command [list sidebar::show_folder_files $rows] -state $show_state 00959 $widgets(menu) add separator 00960 00961 $widgets(menu) add command -label [msgcat::mc "Copy Pathname"] -command [list sidebar::copy_pathname $first_row] -state $one_state 00962 $widgets(menu) add command -label [msgcat::mc "Show Info"] -command [list sidebar::update_info_panel $first_row] -state $one_state 00963 $widgets(menu) add separator 00964 $widgets(menu) add command -label [msgcat::mc "Rename"] -command [list sidebar::rename_folder $first_row] -state $one_act_state 00965 if {[preferences::get General/UseMoveToTrash] && !$remote_found} { 00966 $widgets(menu) add command -label [msgcat::mc "Move To Trash"] -command [list sidebar::move_to_trash $rows] -state $act_state 00967 } else { 00968 $widgets(menu) add command -label [msgcat::mc "Delete"] -command [list sidebar::delete_folder $rows] -state $act_state 00969 } 00970 $widgets(menu) add separator 00971 00972 if {[favorites::is_favorite [$widgets(tl) set $first_row name]]} { 00973 $widgets(menu) add command -label [msgcat::mc "Unfavorite"] -command [list sidebar::unfavorite $first_row] -state $fav_state 00974 } else { 00975 $widgets(menu) add command -label [msgcat::mc "Favorite"] -command [list sidebar::favorite $first_row] -state $fav_state 00976 } 00977 $widgets(menu) add separator 00978 00979 $widgets(menu) add command -label [msgcat::mc "Remove from Sidebar"] -command [list sidebar::remove_folder $rows] 00980 $widgets(menu) add command -label [msgcat::mc "Add Parent Directory"] -command [list sidebar::add_parent_directory $first_row] -state $parent_state 00981 $widgets(menu) add separator 00982 00983 $widgets(menu) add command -label [msgcat::mc "Make Current Working Directory"] -command [list sidebar::set_current_working_directory $first_row] -state $fav_state 00984 $widgets(menu) add command -label [msgcat::mc "Refresh Directory Files"] -command [list sidebar::refresh_directory_files $rows] 00985 $widgets(menu) add separator 00986 00987 $widgets(menu) add cascade -label [msgcat::mc "Sort"] -menu $widgets(sortmenu) -state $sort_state 00988 00989 # Add plugins to sidebar root popup 00990 plugins::handle_root_popup $widgets(menu) 00991 00992 } 00993 00994 ###################################################################### 00995 # Sets up the file popup menu for the currently selected rows. 00996 proc setup_file_menu {rows} { 00997 00998 variable widgets 00999 variable state 01000 01001 set one_state [expr {([llength $rows] == 1) ? "normal" : "disabled"}] 01002 set one_act_state [expr {($state eq "normal") ? $one_state : "disabled"}] 01003 set act_state [expr {($state eq "normal") ? "normal" : "disabled"}] 01004 set hide_state "disabled" 01005 set show_state "disabled" 01006 set open_state "disabled" 01007 set close_state "disabled" 01008 set first_row [lindex $rows 0] 01009 set diff_state [expr {([$widgets(tl) set $first_row remote] eq "") ? $one_act_state : "disabled"}] 01010 set remote_found 0 01011 01012 # Calculate the hide and show menu states 01013 if {$state eq "normal"} { 01014 foreach row $rows { 01015 switch [$widgets(tl) item $row -image] { 01016 "sidebar_hidden" { set close_state "normal"; set show_state "normal" } 01017 "sidebar_open" { set close_state "normal"; set hide_state "normal" } 01018 default { set open_state "normal" } 01019 } 01020 } 01021 } 01022 01023 foreach row $rows { 01024 if {[$widgets(tl) set $row remote] ne ""} { 01025 set remote_found 1 01026 break 01027 } 01028 } 01029 01030 # Delete the menu contents 01031 plugins::delete_from_menu $widgets(menu) 01032 $widgets(menu) delete 0 end 01033 01034 # Create file popup 01035 $widgets(menu) add command -label [msgcat::mc "Open"] -command [list sidebar::open_file $rows] -state $open_state 01036 $widgets(menu) add command -label [msgcat::mc "Close"] -command [list sidebar::close_file $rows] -state $close_state 01037 $widgets(menu) add separator 01038 01039 $widgets(menu) add command -label [msgcat::mc "Hide"] -command [list sidebar::hide_file $rows] -state $hide_state 01040 $widgets(menu) add command -label [msgcat::mc "Show"] -command [list sidebar::show_file $rows] -state $show_state 01041 $widgets(menu) add separator 01042 01043 $widgets(menu) add command -label [msgcat::mc "Copy Pathname"] -command [list sidebar::copy_pathname $first_row] -state $one_state 01044 $widgets(menu) add command -label [msgcat::mc "Show Difference"] -command [list sidebar::show_file_diff $first_row] -state $diff_state 01045 $widgets(menu) add command -label [msgcat::mc "Show Info"] -command [list sidebar::update_info_panel $first_row] -state $one_state 01046 $widgets(menu) add separator 01047 01048 $widgets(menu) add command -label [msgcat::mc "Rename"] -command [list sidebar::rename_file $first_row] -state $one_act_state 01049 $widgets(menu) add command -label [msgcat::mc "Duplicate"] -command [list sidebar::duplicate_file $first_row] -state $one_act_state 01050 if {[preferences::get General/UseMoveToTrash] && !$remote_found} { 01051 $widgets(menu) add command -label [msgcat::mc "Move To Trash"] -command [list sidebar::move_to_trash $rows] -state $act_state 01052 } else { 01053 $widgets(menu) add command -label [msgcat::mc "Delete"] -command [list sidebar::delete_file $rows] -state $act_state 01054 } 01055 $widgets(menu) add separator 01056 01057 if {[favorites::is_favorite [$widgets(tl) set $first_row name]]} { 01058 $widgets(menu) add command -label [msgcat::mc "Unfavorite"] -command [list sidebar::unfavorite $first_row] -state $one_act_state 01059 } else { 01060 $widgets(menu) add command -label [msgcat::mc "Favorite"] -command [list sidebar::favorite $first_row] -state $one_act_state 01061 } 01062 01063 # Add plugins to sidebar file popup 01064 plugins::handle_file_popup $widgets(menu) 01065 01066 } 01067 01068 ###################################################################### 01069 # Setup the sortby menu that is associated with directories. 01070 proc setup_sort_menu {} { 01071 01072 variable widgets 01073 01074 $widgets(sortmenu) add radiobutton -label [msgcat::mc "By Name"] -variable sidebar::sortby -value "name" -command [list sidebar::sort_updated] 01075 $widgets(sortmenu) add separator 01076 $widgets(sortmenu) add radiobutton -label [msgcat::mc "Increasing"] -variable sidebar::sortdir -value "-increasing" -command [list sidebar::sort_updated] 01077 $widgets(sortmenu) add radiobutton -label [msgcat::mc "Decreasing"] -variable sidebar::sortdir -value "-decreasing" -command [list sidebar::sort_updated] 01078 $widgets(sortmenu) add separator 01079 $widgets(sortmenu) add radiobutton -label [msgcat::mc "Manually"] -variable sidebar::sortby -value "manual" -command [list sidebar::sort_updated] 01080 01081 } 01082 01083 ###################################################################### 01084 # Called whenever the sort menu value is changed for one or more 01085 # directories. 01086 proc sort_updated {} { 01087 01088 variable widgets 01089 variable sortby 01090 variable sortdir 01091 variable selection_anchor 01092 01093 if {$sortby eq "manual"} { 01094 foreach row [$widgets(tl) selection] { 01095 $widgets(tl) set $row sortby $sortby 01096 update_directory $row 01097 write_sort_file $row 1 01098 } 01099 } else { 01100 foreach row [$widgets(tl) selection] { 01101 write_sort_file $row 0 01102 $widgets(tl) set $row sortby $sortby:$sortdir 01103 update_directory $row 01104 } 01105 } 01106 01107 } 01108 01109 ###################################################################### 01110 # Returns the sidebar index of the given filename. If the filename 01111 # was not found in the sidebar, return the empty string. 01112 proc get_index {fname remote} { 01113 01114 variable widgets 01115 01116 return [$widgets(tl) tag has $fname,$remote] 01117 01118 } 01119 01120 ###################################################################### 01121 # Returns the indices of the current selections. If nothing is currently 01122 # selected, returns an empty string. 01123 proc get_selected_indices {} { 01124 01125 variable widgets 01126 01127 # Get the current selection 01128 return [$widgets(tl) selection] 01129 01130 } 01131 01132 ###################################################################### 01133 # Returns the information specified by attr for the file at the given 01134 # sidebar index. 01135 proc get_info {index attr} { 01136 01137 variable widgets 01138 01139 switch $attr { 01140 fname { return [$widgets(tl) set $index name] } 01141 file_index { return [files::get_index [$widgets(tl) set $index name] [$widgets(tl) set $index remote]] } 01142 is_dir { return [$widgets(tl) tag has d $index] } 01143 is_open { return [$widgets(tl) item $index -open] } 01144 parent { return [$widgets(tl) parent $index] } 01145 children { return [$widgets(tl) children $index] } 01146 sortby { return [lindex [split [$widgets(tl) set $index sortby] :] 0] } 01147 default { 01148 return -code error "Illegal sidebar attribute specified ($attr)" 01149 } 01150 } 01151 01152 } 01153 01154 ###################################################################### 01155 # Sets the sidebar item attribute to the given value. 01156 proc set_info {index attr value} { 01157 01158 variable widgets 01159 01160 switch $attr { 01161 open { 01162 if {[get_info $index is_dir] && ([$widgets(tl) item $index -open] != $value)} { 01163 if {$value} { 01164 expand_directory $index 01165 } else { 01166 collapse_directory $index 01167 } 01168 } 01169 } 01170 default { 01171 return -code error "Illegal sidebar attribute specified ($attr)" 01172 } 01173 } 01174 01175 } 01176 01177 ###################################################################### 01178 # Sets the hide state of the given file to the given value. 01179 proc set_hide_state {fname remote value} { 01180 01181 variable widgets 01182 01183 # Get the associated index (return immediately if it is not found) 01184 if {[set index [get_index $fname $remote]] eq ""} { 01185 return 01186 } 01187 01188 if {$value} { 01189 set_image $index sidebar_hidden 01190 } else { 01191 set_image $index sidebar_open 01192 } 01193 01194 } 01195 01196 ###################################################################### 01197 # Highlights, dehighlights or must modifies the root count for the given 01198 # filename in the file system sidebar. 01199 # highlight_mode: 01200 # - 0: dehighlight 01201 # - 1: highlight 01202 # - 2: don't change highlight but decrement root count 01203 # - 3: don't change highlight but increment root count 01204 proc highlight_filename {fname highlight_mode} { 01205 01206 variable widgets 01207 01208 foreach row [$widgets(tl) tag has f] { 01209 if {[$widgets(tl) set $row name] eq $fname} { 01210 set highlighted [expr {[$widgets(tl) item $row -image] ne ""}] 01211 switch $highlight_mode { 01212 0 { set_image $row "" } 01213 1 { set_image $row sidebar_open } 01214 } 01215 if {[expr ($highlight_mode % 2) == 0]} { 01216 if {$highlighted || ($highlight_mode == 2)} { 01217 check_root_removal $widgets(tl) $row 01218 } 01219 } 01220 return 01221 } 01222 } 01223 01224 } 01225 01226 ###################################################################### 01227 # Adds the given directory which displays within the file browser. 01228 proc add_directory {dir args} { 01229 01230 variable widgets 01231 01232 array set opts { 01233 -remote "" 01234 -record 1 01235 } 01236 array set opts $args 01237 01238 # Normalize the directory 01239 set dir [file normalize $dir] 01240 01241 # If the directory is not remote, add it to the recently opened menu list 01242 if {$opts(-record) && ($opts(-remote) eq "")} { 01243 add_to_recently_opened $dir 01244 } 01245 01246 # Search for the directory or an ancestor 01247 set last_tdir "" 01248 set tdir $dir 01249 while {($tdir ne $last_tdir) && ([set found [$widgets(tl) tag has "$tdir,$opts(-remote)"]] eq "")} { 01250 set last_tdir $tdir 01251 set tdir [file dirname $tdir] 01252 } 01253 01254 # If the directory was not found, insert the directory as a root directory 01255 if {$found eq ""} { 01256 set roots [$widgets(tl) children {}] 01257 set sortby [get_default_sortby $dir] 01258 set parent [$widgets(tl) insert "" end -text [file tail $dir] -values [list $dir $opts(-remote) $sortby] -open 0 -tags [list d $dir,$opts(-remote)]] 01259 01260 # Otherwise, add missing hierarchy to make directory visible 01261 } else { 01262 set parent $found 01263 foreach tdir [lrange [file split $dir] [llength [file split $tdir]] end] { 01264 set parent [add_subdirectory $parent $opts(-remote) $tdir] 01265 } 01266 } 01267 01268 # Show the directory's contents (if they are not already displayed) 01269 if {($parent ne "") && [$widgets(tl) item $parent -open] == 0} { 01270 add_subdirectory $parent $opts(-remote) 01271 } 01272 01273 # If we just inserted a root directory, check for other rooted directories 01274 # that may be children of this directory and merge them. 01275 if {$found eq ""} { 01276 01277 # Remove any rooted directories that exist within this directory 01278 set dirlen [string length $dir] 01279 foreach root $roots { 01280 set remote [$widgets(tl) set $root remote] 01281 set name [$widgets(tl) set $root name] 01282 if {($remote eq $opts(-remote)) && ([string compare -length $dirlen $name $dir] == 0)} { 01283 $widgets(tl) detach $root 01284 set row [add_directory $name -remote $remote -record 0] 01285 set prow [$widgets(tl) parent $row] 01286 set index [$widgets(tl) index $row] 01287 $widgets(tl) delete $row 01288 $widgets(tl) move $root $prow $index 01289 } 01290 } 01291 01292 } 01293 01294 # Make sure that the directory is visible 01295 set row $parent 01296 while {$row ne ""} { 01297 $widgets(tl) item $row -open 1 01298 set row [$widgets(tl) parent $row] 01299 } 01300 01301 return $parent 01302 01303 } 01304 01305 ###################################################################### 01306 # Recursively adds the current directory and all subdirectories and files 01307 # found within it to the sidebar. 01308 proc add_subdirectory {parent remote {fdir ""}} { 01309 01310 variable widgets 01311 01312 set frow "" 01313 01314 # Clean the subdirectory 01315 $widgets(tl) delete [$widgets(tl) children $parent] 01316 01317 # Get the folder contents and sort them 01318 foreach name [order_files_dirs [$widgets(tl) set $parent name] $remote {*}[split [$widgets(tl) set $parent sortby] :]] { 01319 01320 lassign $name fname dir 01321 01322 if {$dir} { 01323 set sortby [get_default_sortby $fname] 01324 set child [$widgets(tl) insert $parent end -text [file tail $fname] -values [list $fname $remote $sortby] -open 0 -tags [list d $fname,$remote]] 01325 if {[file tail $fname] eq $fdir} { 01326 set frow $child 01327 } 01328 } else { 01329 if {($remote ne "") || ![ignore_file $fname]} { 01330 set key [$widgets(tl) insert $parent end -text [file tail $fname] -values [list $fname $remote ""] -open 1 -tags [list f $fname,$remote]] 01331 if {[files::is_opened $fname $remote]} { 01332 set_image $key sidebar_open 01333 } 01334 } 01335 } 01336 01337 } 01338 01339 return $frow 01340 01341 } 01342 01343 ###################################################################### 01344 # Figure out if the given file should be ignored. 01345 proc ignore_file {fname {ignore_if_binary 0}} { 01346 01347 # Ignore the file if it matches any of the ignore patterns 01348 foreach pattern [preferences::get Sidebar/IgnoreFilePatterns] { 01349 if {[string match $pattern $fname]} { 01350 return 1 01351 } 01352 } 01353 01354 # If the file is a binary file, ignore it 01355 if {($ignore_if_binary || [preferences::get Sidebar/IgnoreBinaries]) && [utils::is_binary $fname]} { 01356 return 1 01357 } 01358 01359 return 0 01360 01361 } 01362 01363 ###################################################################### 01364 # Gathers the given directory's contents and handles directory/file 01365 # ordering issues. 01366 proc order_files_dirs {dir remote sortby {sortdir -increasing}} { 01367 01368 set items [list] 01369 set show_hidden [preferences::get Sidebar/ShowHiddenFiles] 01370 01371 if {$remote ne ""} { 01372 remote::dir_contents $remote $dir items 01373 } elseif {$::tcl_platform(platform) eq "windows"} { 01374 foreach fname [glob -nocomplain -directory $dir *] { 01375 set tail [file tail $fname] 01376 if {($show_hidden && ($tail ne ".") && ($tail ne "..")) || ([string index $tail 0] ne ".")} { 01377 lappend items [list $fname [file isdirectory $fname]] 01378 } 01379 } 01380 } else { 01381 if {$show_hidden} { 01382 foreach fname [glob -nocomplain -directory $dir -types hidden *] { 01383 set tail [file tail $fname] 01384 if {($tail ne ".") && ($tail ne "..")} { 01385 lappend items [list $fname [file isdirectory $fname]] 01386 } 01387 } 01388 } 01389 foreach fname [glob -nocomplain -directory $dir *] { 01390 lappend items [list $fname [file isdirectory $fname]] 01391 } 01392 } 01393 01394 # If a sortfile exists and is marked to be used, perform a manual sort 01395 if {($remote eq "") && ![catch { tkedat::read [file join $dir .tkesort] } rc]} { 01396 array set contents $rc 01397 if {![info exists contents(use)] || $contents(use) || ($sortby eq "manual")} { 01398 set new_items [lrepeat [llength $contents(items)] ""] 01399 set extra_items [list] 01400 foreach item $items { 01401 set tail [file tail [lindex $item 0]] 01402 if {[set index [lsearch $contents(items) $tail]] != -1} { 01403 lset new_items $index $item 01404 } elseif {$tail ne ".tkesort"} { 01405 lappend extra_items $item 01406 } 01407 } 01408 if {[preferences::get Sidebar/ManualInsertNewAtTop]} { 01409 return [lmap item [concat $extra_items $new_items] {expr {($item ne "") ? $item : [continue]}}] 01410 } else { 01411 return [lmap item [concat $new_items $extra_items] {expr {($item ne "") ? $item : [continue]}}] 01412 } 01413 } 01414 } 01415 01416 # If we are supposed to sort with folders at the top, return that listing 01417 if {[preferences::get Sidebar/FoldersAtTop]} { 01418 return [list {*}[lsort $sortdir -unique -index 0 [lsearch -inline -all -index 1 $items 1]] \ 01419 {*}[lsort $sortdir -unique -index 0 [lsearch -inline -all -index 1 $items 0]]] 01420 } 01421 01422 return [lsort $sortdir -unique -index 0 $items] 01423 01424 } 01425 01426 ###################################################################### 01427 # Recursively updates the given directory (if the child directories 01428 # are already expanded. 01429 proc update_directory_recursively {parent} { 01430 01431 variable widgets 01432 01433 # If the parent is not root, update the directory 01434 if {$parent ne ""} { 01435 update_directory $parent 01436 } 01437 01438 # Update the child directories that are expanded 01439 foreach child [$widgets(tl) children $parent] { 01440 if {[$widgets(tl) item $child -open]} { 01441 update_directory_recursively $child 01442 } 01443 } 01444 01445 } 01446 01447 ###################################################################### 01448 # Update the given directory to include (or uninclude) new file 01449 # information. 01450 proc update_directory {parent} { 01451 01452 variable widgets 01453 01454 # Get the remote indicator of the parent 01455 set remote [$widgets(tl) set $parent remote] 01456 01457 # Get the list of opened subdirectories 01458 set opened [list] 01459 foreach child [$widgets(tl) children $parent] { 01460 if {[$widgets(tl) item $child -open]} { 01461 lappend opened $child [$widgets(tl) set $child name] 01462 $widgets(tl) detach $child 01463 } 01464 } 01465 01466 # Update the parent directory contents 01467 add_subdirectory $parent $remote 01468 01469 # Replace any exist directories in the update directory with the opened 01470 foreach {item dname} $opened { 01471 if {[set old_item [$widgets(tl) tag has $dname,$remote]] ne ""} { 01472 $widgets(tl) move $item $parent [$widgets(tl) index $old_item] 01473 $widgets(tl) delete $old_item 01474 } 01475 } 01476 01477 } 01478 01479 ###################################################################### 01480 # Finds the root directory of the given descendent and updates its 01481 # value +/- the value. 01482 proc check_root_removal {w item} { 01483 01484 # Get the root directory in the table 01485 while {[set parent [$w parent $item]] ne ""} { 01486 set item $parent 01487 } 01488 01489 # If the user wants us to auto-remove when the open file count reaches 0, 01490 # remove it from the sidebar 01491 if {[preferences::get Sidebar/RemoveRootAfterLastClose] && ([files::num_opened [$w get $item name] [$w get $item remote]] == 0)} { 01492 $w delete $item 01493 } 01494 01495 } 01496 01497 ###################################################################### 01498 # Expands the currently selected directory. 01499 proc expand_directory {{row ""}} { 01500 01501 variable widgets 01502 01503 if {$row eq ""} { 01504 set row [$widgets(tl) focus] 01505 } 01506 01507 # Add the missing subdirectory 01508 add_subdirectory $row [$widgets(tl) set $row remote] 01509 01510 # Make sure that the row is opened 01511 $widgets(tl) item $row -open 1 01512 01513 } 01514 01515 ###################################################################### 01516 # Called when a row is collapsed in the table. 01517 proc collapse_directory {{row ""}} { 01518 01519 variable widgets 01520 01521 if {$row eq ""} { 01522 set row [$widgets(tl) focus] 01523 } 01524 01525 # If the row contains a file, make sure that the state remains open 01526 if {[$widgets(tl) tag has f $row]} { 01527 $widgets(tl) item $row -open 1 01528 } 01529 01530 } 01531 01532 ###################################################################### 01533 # Inserts the given file into the sidebar under the given parent. 01534 proc insert_file {parent fname remote} { 01535 01536 variable widgets 01537 01538 # Check to see if the file is an ignored file 01539 if {![ignore_file $fname]} { 01540 01541 # Compare the children of the parent to the given fname 01542 set i 0 01543 foreach child [$widgets(tl) children $parent] { 01544 if {[$widgets(tl) tag has f $child]} { 01545 set compare [string compare $fname [$widgets(tl) set $child name]] 01546 if {$compare == 0} { 01547 set_image $child sidebar_open 01548 return 01549 } elseif {$compare == -1} { 01550 $widgets(tl) insert $parent $i -text [file tail $fname] -image sidebar_open -open 1 -values [list $fname $remote ""] -tags [list f $fname,$remote] 01551 return 01552 } 01553 } 01554 incr i 01555 } 01556 01557 # Insert the file at the end of the parent 01558 $widgets(tl) insert $parent end -text [file tail $fname] -image sidebar_open -open 1 -values [list $fname $remote ""] -tags [list f $fname,$remote] 01559 01560 } 01561 01562 } 01563 01564 ###################################################################### 01565 # Displays a tooltip for each root row. 01566 proc show_tooltip {row} { 01567 01568 variable widgets 01569 01570 if {($row ne "") && ([$widgets(tl) parent $row] eq "")} { 01571 set dirname [$widgets(tl) set $row name] 01572 if {[set remote [$widgets(tl) set $row remote]] ne ""} { 01573 tooltip::tooltip $widgets(tl) "$dirname ([lindex [split $remote ,] 1])" 01574 } else { 01575 tooltip::tooltip $widgets(tl) $dirname 01576 } 01577 event generate $widgets(tl) <Enter> 01578 } else { 01579 tooltip::tooltip clear $widgets(tl) 01580 } 01581 01582 } 01583 01584 ###################################################################### 01585 # Displays the thumbnail for the given row, if possible. 01586 proc show_thumbnail {row x y} { 01587 01588 # OBSOLETE - We are disabling this functionality 01589 return 01590 01591 variable widgets 01592 01593 if {$row ne ""} { 01594 set x [expr [winfo rootx $widgets(tl)] + [winfo width $widgets(tl)]] 01595 set y [expr [winfo rooty $widgets(tl)] + $y] 01596 thumbnail::show [$widgets(tl) set $row name] $x $y 01597 } else { 01598 thumbnail::hide 01599 } 01600 01601 } 01602 01603 ###################################################################### 01604 # Hides the tooltip associated with the root row. 01605 proc hide_tooltip {} { 01606 01607 variable widgets 01608 01609 tooltip::tooltip clear $widgets(tl) 01610 01611 } 01612 01613 ###################################################################### 01614 # Handle a selection change to the sidebar. 01615 proc handle_selection {} { 01616 01617 variable widgets 01618 variable selection_anchor 01619 variable select_id 01620 01621 if {$select_id != -1} { 01622 after cancel $select_id 01623 set select_id "" 01624 } 01625 01626 # Clear the selection 01627 $widgets(tl) tag remove sel 01628 01629 # Get the current selection 01630 if {[llength [set selected [$widgets(tl) selection]]]} { 01631 01632 # If we have only one thing selected, set the selection anchor to be it 01633 if {[llength $selected] == 1} { 01634 set selection_anchor [lindex $selected 0] 01635 } 01636 01637 # Make sure that all of the selections matches the same type (root, dir, file) 01638 set anchor_type [row_type $selection_anchor] 01639 foreach row $selected { 01640 if {[row_type $row] ne $anchor_type} { 01641 $widgets(tl) selection remove $row 01642 } 01643 } 01644 01645 # Colorize the selected items to be selected 01646 $widgets(tl) tag add sel [$widgets(tl) selection] 01647 01648 # If the information panel should be updated, do it now 01649 update_info_panel_for_selection 01650 01651 } 01652 01653 } 01654 01655 ###################################################################### 01656 # Handles a left-click on the sidebar. 01657 proc handle_left_press {W x y tkdnd_cmd} { 01658 01659 variable widgets 01660 variable mover 01661 01662 if {[set row [$widgets(tl) identify item $x $y]] eq ""} { 01663 return 0 01664 } 01665 01666 # Get the information that we need for moving the selections to 01667 # a new location 01668 set selected [$widgets(tl) selection] 01669 set mover(start) $row 01670 set mover(rows) [expr {([lsearch $selected $row] == -1) ? $row : $selected}] 01671 set mover(detached) 0 01672 01673 # If the user clicks on the disclosure triangle, let the treeview 01674 # handle the left press event 01675 switch -glob -- [$widgets(tl) identify element $x $y] { 01676 *.indicator - 01677 *.disclosure { 01678 return 0 01679 } 01680 } 01681 01682 # If drag and drop is enabled, call our tkdnd_press method 01683 if {$tkdnd_cmd ne ""} { 01684 tkdnd_press {*}$tkdnd_cmd 01685 } 01686 01687 # If the clicked row is not within the current selection 01688 return [expr {([llength $selected] > 1) && ([lsearch $selected $row] != -1)}] 01689 01690 } 01691 01692 ###################################################################### 01693 # Handles a left-click button release event. If we were doing a drag 01694 # and drop file move motion, move the files/folders to the new location. 01695 proc handle_left_release {W x y} { 01696 01697 variable widgets 01698 variable mover 01699 variable tkdnd_drag 01700 01701 # Release the drag and drop event, if we doing that 01702 tkdnd_release 01703 01704 # If we are in a tkdnd_drag call, we have nothing more to do 01705 if {$tkdnd_drag} { 01706 return 01707 } 01708 01709 # Cancel a pending spring and/or scan operation 01710 spring_cancel 01711 tree_scan_cancel up 01712 tree_scan_cancel down 01713 01714 if {[set row [$widgets(tl) identify item $x $y]] eq ""} { 01715 return 01716 } 01717 01718 # If we are moving rows, handle them now 01719 if {[info exists mover(detached)] && $mover(detached)} { 01720 01721 $widgets(tl) configure -cursor "" 01722 01723 if {[$widgets(tl) tag has moveto $row]} { 01724 01725 set dir [$widgets(tl) set $row name] 01726 01727 $widgets(tl) tag remove moveto $row 01728 01729 if {[$widgets(tl) item $row -open] == 0} { 01730 foreach item $mover(rows) { 01731 if {[move_item $widgets(tl) $item $row]} { 01732 $widgets(tl) delete $item 01733 } 01734 } 01735 } else { 01736 foreach item $mover(rows) { 01737 if {[move_item $widgets(tl) $item $row]} { 01738 $widgets(tl) detach $item 01739 $widgets(tl) move $item $row end 01740 update_filenames $widgets(tl) $item $dir 01741 } 01742 } 01743 if {[$widgets(tl) set $row sortby] eq "manual"} { 01744 write_sort_file $row 01745 } else { 01746 update_directory $row 01747 } 01748 } 01749 01750 } elseif {[winfo ismapped $widgets(insert)]} { 01751 01752 lassign [$widgets(tl) bbox $row] bx by bw bh 01753 01754 set parent [$widgets(tl) parent $row] 01755 set parentdir [$widgets(tl) set $parent name] 01756 01757 if {$by != [lindex [place configure $widgets(insert) -y] 4]} { 01758 set irow [$widgets(tl) next $row] 01759 if {[get_info $row is_dir]} { 01760 set parent $row 01761 set parentdir [$widgets(tl) set $row name] 01762 set irow [lindex [$widgets(tl) children $row] 0] 01763 } 01764 } else { 01765 set irow $row 01766 } 01767 01768 # Remove the insertion bar 01769 place forget $widgets(insert) 01770 01771 # Move the files in the file system and in the sidebar treeview 01772 foreach item [lreverse $mover(rows)] { 01773 if {$item ne $irow} { 01774 if {[move_item $widgets(tl) $item $parent]} { 01775 $widgets(tl) detach $item 01776 $widgets(tl) move $item $parent [expr {($irow eq "") ? "end" : [$widgets(tl) index $irow]}] 01777 update_filenames $widgets(tl) $item $parentdir 01778 set irow $item 01779 } 01780 } 01781 } 01782 01783 # Specify that the directory should be sorted manually 01784 $widgets(tl) set $parent sortby "manual" 01785 01786 # Create the sort file 01787 write_sort_file $parent 01788 01789 } 01790 01791 # If the file is currently in the notebook, make it the current tab 01792 } else { 01793 01794 # Select the row if we did not move the selection 01795 if {[info exists mover(rows)] && ([lsearch $mover(rows) $row] != -1)} { 01796 $widgets(tl) selection set $row 01797 } 01798 01799 if {[$widgets(tl) item $row -image] ne ""} { 01800 set fileindex [files::get_index [$widgets(tl) set $row name] [$widgets(tl) set $row remote]] 01801 gui::get_info $fileindex fileindex tabbar tab 01802 gui::set_current_tab $tabbar $tab 01803 } 01804 01805 } 01806 01807 } 01808 01809 ###################################################################### 01810 # Attempts to move the given item to the parent directory 01811 proc move_item {w item parent} { 01812 01813 if {$parent eq [$w parent $item]} { 01814 01815 return 1 01816 01817 } else { 01818 01819 set fname [$w set $item name] 01820 set remote [$w set $item remote] 01821 set parentdir [$w set $parent name] 01822 01823 if {[get_info $item is_dir]} { 01824 if {![catch { files::move_folder $fname $remote $parentdir } rc]} { 01825 return 1 01826 } 01827 } else { 01828 if {![catch { files::move_file $fname $remote $parentdir } rc]} { 01829 return 1 01830 } 01831 } 01832 01833 } 01834 01835 return 0 01836 01837 } 01838 01839 ###################################################################### 01840 # Counts the number of opened files in the given node tree. 01841 proc count_opened {w item} { 01842 01843 set count [expr {[$w item $item -image] ne ""}] 01844 01845 foreach child [$w children $item] { 01846 incr count [count_opened $w $child] 01847 } 01848 01849 return $count 01850 01851 } 01852 01853 ###################################################################### 01854 # Updates all of the filenames 01855 proc update_filenames {w item dir} { 01856 01857 # Get the original name 01858 set old_name [$w set $item name] 01859 01860 # Update the name of the item 01861 $w set $item name [set dir [file join $dir [file tail $old_name]]] 01862 01863 # Update the children 01864 foreach child [$w children $item] { 01865 update_filenames $w $child $dir 01866 } 01867 01868 } 01869 01870 ###################################################################### 01871 # Add the clicked row to the selection and make it the new selection anchor. 01872 proc handle_control_left_click {W x y} { 01873 01874 variable widgets 01875 01876 if {[set row [$widgets(tl) identify item $x $y]] eq ""} { 01877 return 01878 } 01879 01880 $widgets(tl) selection add $row 01881 $widgets(tl) focus $row 01882 01883 } 01884 01885 ###################################################################### 01886 # Handles a control right click on a sidebar item, displaying the information 01887 # panel. 01888 proc handle_control_right_click {W x y} { 01889 01890 variable widgets 01891 01892 if {[set row [$widgets(tl) identify item $x $y]] eq ""} { 01893 return 01894 } 01895 01896 # Update the information panel 01897 update_info_panel $row 01898 01899 } 01900 01901 ###################################################################### 01902 # Handles right click from the sidebar table. 01903 proc handle_right_click {W x y} { 01904 01905 variable widgets 01906 variable selection_anchor 01907 01908 # If nothing is currently selected, select the row under the cursor 01909 if {[llength [$widgets(tl) selection]] == 0} { 01910 01911 if {[set row [$widgets(tl) identify item $x $y]] eq ""} { 01912 return 01913 } 01914 01915 # Set the selection to the right-clicked element 01916 $widgets(tl) selection set $row 01917 handle_selection 01918 01919 } 01920 01921 # Display the menu 01922 tk_popup $widgets(menu) [expr [winfo rootx $W] + $x] [expr [winfo rooty $W] + $y] 01923 01924 } 01925 01926 ###################################################################### 01927 # Handles double-click from the sidebar table. 01928 proc handle_double_click {W x y} { 01929 01930 variable widgets 01931 variable select_id 01932 variable state 01933 01934 if {$select_id ne ""} { 01935 after cancel $select_id 01936 set select_id "" 01937 } 01938 01939 if {$state ne "normal"} { 01940 return 01941 } 01942 01943 if {[set row [$widgets(tl) identify item $x $y]] eq ""} { 01944 return 01945 } 01946 01947 if {[$widgets(tl) tag has f $row]} { 01948 01949 # Select the file 01950 $widgets(tl) selection set $row 01951 01952 # Open the file in the viewer 01953 gui::add_file end [$widgets(tl) set $row name] -remote [$widgets(tl) set $row remote] 01954 01955 } 01956 01957 } 01958 01959 ###################################################################### 01960 # Handles a press of the return key when the sidebar has the focus. 01961 proc handle_return_space {W} { 01962 01963 variable widgets 01964 variable state 01965 01966 # Get the selected rows 01967 set selected [$widgets(tl) selection] 01968 01969 # Get the currently selected rows 01970 foreach row $selected { 01971 01972 # Open the file in the viewer 01973 if {[$widgets(tl) tag has f $row]} { 01974 01975 # Add the file 01976 if {$state eq "normal"} { 01977 gui::add_file end [$widgets(tl) set $row name] -remote [$widgets(tl) set $row remote] 01978 } 01979 01980 # Otherwise, toggle the open status 01981 } else { 01982 if {[$widgets(tl) item $row -open]} { 01983 $widgets(tl) item $row -open 0 01984 } else { 01985 expand_directory $row 01986 } 01987 } 01988 01989 } 01990 01991 } 01992 01993 ###################################################################### 01994 # Handles the press of an escape key. 01995 proc handle_escape {W} { 01996 01997 variable widgets 01998 variable mover 01999 02000 if {$mover(detached)} { 02001 set mover(detached) 0 02002 set mover(start) "" 02003 $widgets(tl) tag remove moveto 02004 place forget $widgets(insert) 02005 } else { 02006 pack forget $widgets(info) 02007 } 02008 02009 } 02010 02011 ###################################################################### 02012 # Handles a BackSpace key in the sidebar. Closes the currently selected 02013 # files if they are opened. 02014 proc handle_backspace {W} { 02015 02016 variable widgets 02017 variable state 02018 02019 if {$state ne "normal"} { 02020 return 02021 } 02022 02023 # Close the currently selected rows 02024 close_file [$widgets(tl) selection] 02025 02026 } 02027 02028 ###################################################################### 02029 # Handles a Control-Return or Control-Space event. 02030 proc handle_control_return_space {W} { 02031 02032 variable widgets 02033 02034 # Get the selected rows 02035 set selected [$widgets(tl) selection] 02036 02037 # Update the information panel 02038 update_info_panel $selected 02039 02040 } 02041 02042 ###################################################################### 02043 # Handles mouse motion in the sidebar, displaying tooltips over the 02044 # root directories to display the full pathname (and possibly remote 02045 # information as well). 02046 proc handle_motion {W x y} { 02047 02048 variable widgets 02049 variable last_id 02050 variable after_id 02051 02052 set id [$W identify item $x $y] 02053 set lastId $last_id 02054 set last_id $id 02055 02056 if {$id ne $lastId} { 02057 after cancel $after_id 02058 if {$lastId ne ""} { 02059 hide_tooltip 02060 } 02061 if {$id ne ""} { 02062 set after_id [after 300 sidebar::show_tooltip $id] 02063 } 02064 } 02065 02066 } 02067 02068 ###################################################################### 02069 # Returns 1 if the given id is within the currently selected rows. 02070 proc is_droppable {w id} { 02071 02072 variable mover 02073 02074 # If the file is remote or the target is not a file and the sortby type is not set to manual, we are not 02075 # droppable 02076 if {([$w set $id remote] ne "") || (![get_info $id is_dir] && ([$w set [$w parent $id] sortby] ne "manual"))} { 02077 return 0 02078 } 02079 02080 # Check to see if the target is within anything this is currently selected 02081 while {($id ne "") && ([lsearch $mover(rows) $id] == -1)} { 02082 set id [$w parent $id] 02083 } 02084 02085 return [expr {$id eq ""}] 02086 02087 } 02088 02089 ###################################################################### 02090 # Handles button-1 motion events. Causes selected files to be detached 02091 # so that they can be placed in a different location. 02092 proc handle_b1_motion {W x y tkdnd_cmd} { 02093 02094 variable widgets 02095 variable mover 02096 variable spring_id 02097 variable tkdnd_drag 02098 02099 # Call the tkdnd_motion procedure if the command is valid. 02100 if {$tkdnd_cmd ne ""} { 02101 tkdnd_motion {*}$tkdnd_cmd 02102 } 02103 02104 # If we are in the middle of a tkdnd drag event, return immediately 02105 if {$tkdnd_drag} { 02106 return 02107 } 02108 02109 # Get the current row 02110 if {[set id [$W identify item $x $y]] eq ""} { 02111 return 02112 } 02113 02114 # If the current row exists within one of the selected files or the target 02115 # directory is a remote directory, don't allow the file/directory to be moved there. 02116 if {![is_droppable $widgets(tl) $id]} { 02117 $widgets(tl) tag remove moveto 02118 place forget $widgets(insert) 02119 spring_cancel 02120 return 02121 } 02122 02123 lassign [$widgets(tl) bbox $id] bx by bw bh 02124 02125 if {$mover(detached)} { 02126 if {([set first [$widgets(tl) identify item 0 0]] ne "") && ($first eq $id)} { 02127 tree_scan_start $widgets(tl) up 02128 } else { 02129 tree_scan_cancel up 02130 } 02131 if {([set last [$widgets(tl) identify item 0 [winfo height $widgets(tl)]]] ne "") && ($last eq $id)} { 02132 tree_scan_start $widgets(tl) down 02133 } else { 02134 tree_scan_cancel down 02135 } 02136 if {$by eq ""} { 02137 $widgets(tl) tag remove moveto 02138 place forget $widgets(insert) 02139 spring_cancel 02140 } elseif {$y < ($by + int($bh * 0.25))} { 02141 $widgets(tl) tag remove moveto 02142 place $widgets(insert) -y $by -width $bw 02143 spring_cancel 02144 } elseif {$y > ($by + int($bh * 0.75))} { 02145 $widgets(tl) tag remove moveto 02146 place $widgets(insert) -y [expr $by + $bh] -width $bw 02147 spring_cancel 02148 } elseif {[get_info $id is_dir]} { 02149 if {($spring_id eq "") && ![$widgets(tl) item $id -open] && [lsearch [$widgets(tl) item $id -tags] moveto] == -1} { 02150 set spring_id [after 1000 [list sidebar::spring_directory $id]] 02151 } 02152 $widgets(tl) tag add moveto $id 02153 place forget $widgets(insert) 02154 } else { 02155 $widgets(tl) tag remove moveto 02156 spring_cancel 02157 } 02158 } elseif {($mover(start) ne "") && ($id ne $mover(start))} { 02159 set mover(detached) 1 02160 $widgets(tl) configure -cursor [ttk::cursor move] 02161 } 02162 02163 } 02164 02165 ###################################################################### 02166 # Start a tree scan. 02167 proc tree_scan_start {w dir} { 02168 02169 variable scan_id 02170 02171 if {$scan_id($dir) ne ""} { 02172 return 02173 } 02174 02175 set scan_id($dir) [after 900 [list sidebar::tree_scan $w $dir [expr int(900 * 0.3)]]] 02176 02177 } 02178 02179 ###################################################################### 02180 # Perform a tree scan operation. 02181 proc tree_scan {w dir {delay ""}} { 02182 02183 variable scan_id 02184 02185 switch $dir { 02186 up { 02187 set focus [$w identify item 0 0] 02188 if {[set up [$w prev $focus]] eq ""} { 02189 set focus [$w parent $focus] 02190 } else { 02191 while {[$w item $up -open] && [llength [$w children $up]]} { 02192 set up [lindex [$w children $up] end] 02193 } 02194 set focus $up 02195 } 02196 } 02197 down { 02198 set focus [$w identify item 0 [winfo height $w]] 02199 if {[$w item $focus -open] && [llength [$w children $focus]]} { 02200 set focus [lindex [$w children $focus] 0] 02201 } else { 02202 set up $focus 02203 set down "" 02204 while {($up ne "") && ([set down [$w next $up]] eq "")} { 02205 set up [$w parent $up] 02206 } 02207 set focus $down 02208 } 02209 } 02210 } 02211 02212 # If the next row was not found, exit 02213 if {$focus eq ""} { 02214 return 02215 } 02216 02217 # Make sure that the given row is in view 02218 $w see $focus 02219 02220 # Set the scan directory 02221 set scan_id($dir) [after [expr ($delay < 30) ? 30 : $delay] [list sidebar::tree_scan $w $dir [expr int($delay * 0.3)]]] 02222 02223 } 02224 02225 ###################################################################### 02226 # Cancel the tree scan 02227 proc tree_scan_cancel {dir} { 02228 02229 variable scan_id 02230 02231 if {$scan_id($dir) ne ""} { 02232 after cancel $scan_id($dir) 02233 set scan_id($dir) "" 02234 } 02235 02236 } 02237 02238 ###################################################################### 02239 # Perform a spring open. 02240 proc spring_directory {row} { 02241 02242 variable spring_id 02243 02244 # Clear the spring ID 02245 set spring_id "" 02246 02247 # Open the directory 02248 expand_directory $row 02249 02250 } 02251 02252 ###################################################################### 02253 # Cancel a spring operation. 02254 proc spring_cancel {} { 02255 02256 variable spring_id 02257 02258 if {$spring_id ne ""} { 02259 after cancel $spring_id 02260 set spring_id "" 02261 } 02262 02263 } 02264 02265 ###################################################################### 02266 # Handles any key binding which is used for search purposes within the 02267 # sidebar. 02268 proc handle_any {keysym char} { 02269 02270 variable widgets 02271 variable jump_str 02272 variable jump_after_id 02273 02274 if {[string is control $char] || ([set selected [lindex [$widgets(tl) selection] 0]] eq "")} { 02275 return 02276 } 02277 02278 # Stop the jump string from being cleared 02279 if {$jump_after_id ne ""} { 02280 after cancel $jump_after_id 02281 set jump_after_id "" 02282 } 02283 02284 # Add to the jump string 02285 append jump_str $char 02286 02287 # Get the parent directory to search 02288 set parent [expr {([get_info $selected is_dir] && [$widgets(tl) item $selected -open]) ? $selected : [$widgets(tl) parent $selected]}] 02289 02290 # Perform the search within the table 02291 foreach row [$widgets(tl) children $parent] { 02292 if {[string match -nocase $jump_str* [string trim [$widgets(tl) item $row -text]]]} { 02293 $widgets(tl) focus $row 02294 $widgets(tl) selection set $row 02295 $widgets(tl) see $row 02296 break 02297 } 02298 } 02299 02300 # Clear the jump string after a given amount of time 02301 set jump_after_id [after [preferences::get Sidebar/KeySearchTimeout] { 02302 set sidebar::jump_str "" 02303 set sidebar::jump_after_id "" 02304 }] 02305 02306 } 02307 02308 ###################################################################### 02309 # Handles the sidebar gaining focus. 02310 proc handle_focus_in {} { 02311 02312 variable widgets 02313 02314 if {[ipanel::is_viewable $widgets(info,panel)]} { 02315 pack $widgets(info) -fill both 02316 } 02317 02318 } 02319 02320 ###################################################################### 02321 # Handles the sidebar losing focus. 02322 proc handle_focus_out {} { 02323 02324 variable widgets 02325 02326 if {![preferences::get Sidebar/KeepInfoPanelVisible]} { 02327 pack forget $widgets(info) 02328 } 02329 02330 } 02331 02332 ###################################################################### 02333 # Copies the given row's file/folder pathname to the clipboard. 02334 proc copy_pathname {row} { 02335 02336 variable widgets 02337 02338 # Set the clipboard to the currentl selection 02339 clipboard clear 02340 clipboard append [$widgets(tl) set $row name] 02341 02342 # Add the clipboard contents to history 02343 cliphist::add_from_clipboard 02344 02345 } 02346 02347 ###################################################################### 02348 # Adds a new file to the given folder. 02349 proc add_file_to_folder {row args} { 02350 02351 variable widgets 02352 02353 array set opts { 02354 -testname "" 02355 } 02356 array set opts $args 02357 02358 if {$opts(-testname) eq ""} { 02359 02360 # Get the new filename from the user 02361 set fname "" 02362 if {![gui::get_user_response [msgcat::mc "File Name:"] fname -allow_vars 1]} { 02363 return 02364 } 02365 02366 } else { 02367 set fname $opts(-testname) 02368 } 02369 02370 # Normalize the pathname 02371 if {[set pathtype [file pathtype $fname]] eq "relative"} { 02372 set fname [file join [$widgets(tl) set $row name] $fname] 02373 } 02374 02375 # Get the remote status 02376 set remote [$widgets(tl) set $row remote] 02377 02378 # Create the file 02379 if {$remote eq ""} { 02380 if {[catch { file mkdir [file dirname $fname] }]} { 02381 return 02382 } 02383 if {[catch { open $fname w } rc]} { 02384 return 02385 } 02386 close $rc 02387 } else { 02388 if {![remote::save_file $remote $fname " " modtime]} { 02389 return 02390 } 02391 } 02392 02393 # Create an empty file 02394 gui::add_file end $fname -remote $remote 02395 02396 } 02397 02398 ###################################################################### 02399 # Prompts the user for a name which will be placed in the selected 02400 # directory, then prompts the user to select a template, and finally 02401 # inserts the file into the editing buffer and performs any snippet 02402 # transformations. 02403 proc add_file_from_template {row} { 02404 02405 variable widgets 02406 02407 # Add the file 02408 if {![catch { templates::show_templates load_rel [$widgets(tl) set $row name] -remote [$widgets(tl) set $row remote] }]} { 02409 02410 # Expand the directory 02411 expand_directory $row 02412 02413 } 02414 02415 } 02416 02417 ###################################################################### 02418 # Adds a new folder to the specified folder. 02419 proc add_folder_to_folder {row args} { 02420 02421 variable widgets 02422 02423 array set opts { 02424 -testname "" 02425 } 02426 array set opts $args 02427 02428 if {$opts(-testname) eq ""} { 02429 02430 # Get the directory name from the user 02431 set dname "" 02432 if {![gui::get_user_response [msgcat::mc "Directory Name:"] dname -allow_vars 1]} { 02433 return 02434 } 02435 02436 } else { 02437 set dname $opts(-testname) 02438 } 02439 02440 # Normalize the pathname 02441 if {[set pathtype [file pathtype $dname]] eq "relative"} { 02442 set dname [file join [$widgets(tl) set $row name] $dname] 02443 } 02444 02445 # Get the remote status 02446 set remote [$widgets(tl) set $row remote] 02447 02448 # Create the directory 02449 if {$remote eq ""} { 02450 if {[catch { file mkdir $dname }]} { 02451 return 02452 } 02453 } else { 02454 if {![remote::make_directory $remote $dname]} { 02455 return 02456 } 02457 } 02458 02459 # If we are absolute, add the directory to the sidebar 02460 $widgets(tl) selection set [add_directory $dname -remote $remote] 02461 02462 } 02463 02464 ###################################################################### 02465 # Opens all of the files in the current directory. 02466 proc open_folder_files {rows} { 02467 02468 variable widgets 02469 02470 set tab "" 02471 02472 foreach row $rows { 02473 02474 # Open all of the children that are not already opened 02475 foreach child [$widgets(tl) children $row] { 02476 set name [$widgets(tl) set $child name] 02477 if {([$widgets(tl) item $child -image] eq "") && [$widgets(tl) tag has f $child]} { 02478 set tab [gui::add_file end $name -lazy 1 -remote [$widgets(tl) set $child remote]] 02479 } 02480 } 02481 02482 } 02483 02484 # Display the current tab 02485 if {$tab ne ""} { 02486 gui::set_current_tab [gui::get_info $tab tab tabbar] $tab 02487 } 02488 02489 } 02490 02491 ###################################################################### 02492 # Close all of the open files in the current directory. 02493 proc close_folder_files {rows} { 02494 02495 variable widgets 02496 02497 set indices [list] 02498 02499 # Gather all of the opened file names 02500 foreach row $rows { 02501 foreach child [$widgets(tl) children $row] { 02502 if {[$widgets(tl) item $child -image] ne ""} { 02503 lappend indices [files::get_index [$widgets(tl) set $child name] [$widgets(tl) set $child remote]] 02504 } 02505 } 02506 } 02507 02508 # Close all of the files 02509 gui::close_files $indices 02510 02511 } 02512 02513 ###################################################################### 02514 # Closes any opened files within a directory, disconnects from the 02515 # server and removes the directory from the sidebar. 02516 proc disconnect {rows} { 02517 02518 variable widgets 02519 02520 foreach row $rows { 02521 if {[set remote [$widgets(tl) set $row remote]] ne ""} { 02522 close_folder_files $row 02523 remote::disconnect $remote 02524 $widgets(tl) delete $row 02525 } 02526 } 02527 02528 } 02529 02530 ###################################################################### 02531 # Disconnects by remote name. 02532 proc disconnect_by_name {remote} { 02533 02534 variable widgets 02535 02536 foreach child [$widgets(tl) children ""] { 02537 if {[$widgets(tl) set $child remote] eq $remote} { 02538 disconnect $child 02539 return 02540 } 02541 } 02542 02543 } 02544 02545 ###################################################################### 02546 # Hide all of the open files in the current directory. 02547 proc hide_folder_files {rows} { 02548 02549 variable widgets 02550 02551 set indices [list] 02552 02553 # Gather all of the opened file names 02554 foreach row $rows { 02555 foreach child [$widgets(tl) children $row] { 02556 if {[$widgets(tl) item $child -image] ne ""} { 02557 lappend indices [files::get_index [$widgets(tl) set $child name] [$widgets(tl) set $child remote]] 02558 } 02559 } 02560 } 02561 02562 # Hide all of the files 02563 gui::hide_files $indices 02564 02565 } 02566 02567 ###################################################################### 02568 # Show all of the open files in the current directory. 02569 proc show_folder_files {rows} { 02570 02571 variable widgets 02572 02573 set indices [list] 02574 02575 # Gather all of the opened file names 02576 foreach row $rows { 02577 foreach child [$widgets(tl) children $row] { 02578 if {[$widgets(tl) item $child -image] ne ""} { 02579 lappend indices [files::get_index [$widgets(tl) set $child name] [$widgets(tl) set $child remote]] 02580 } 02581 } 02582 } 02583 02584 # Show all of the files 02585 gui::show_files $indices 02586 02587 } 02588 02589 ###################################################################### 02590 # Allows the user to rename the currently selected folder. 02591 proc rename_folder {row args} { 02592 02593 variable widgets 02594 02595 array set opts { 02596 -testname "" 02597 } 02598 array set opts $args 02599 02600 # Get the current name 02601 set old_dname [set dname [$widgets(tl) set $row name]] 02602 02603 # Get the new name from the user 02604 if {($opts(-testname) ne "") || [gui::get_user_response [msgcat::mc "Folder Name:"] dname -allow_vars 1 -selrange {0 end}]} { 02605 02606 # Make the fname match the testname option if it was set 02607 if {$opts(-testname) ne ""} { 02608 set dname $opts(-testname) 02609 } 02610 02611 # If the value of the cell hasn't changed or is empty, do nothing else. 02612 if {($old_dname eq $dname) || ($dname eq "")} { 02613 return 02614 } 02615 02616 # Get the remote status 02617 set remote [$widgets(tl) set $row remote] 02618 02619 # Rename the folder 02620 set dname [files::rename_folder $old_dname $dname $remote] 02621 02622 # Delete the old directory 02623 $widgets(tl) delete $row 02624 02625 # Add the file directory 02626 update_directory [add_directory $dname -remote $remote] 02627 02628 } 02629 02630 } 02631 02632 ###################################################################### 02633 # Allows the user to delete the folder at the given row. 02634 proc delete_folder {rows args} { 02635 02636 variable widgets 02637 02638 array set opts { 02639 -test 0 02640 } 02641 array set opts $args 02642 02643 if {[llength $rows] == 1} { 02644 set question [msgcat::mc "Delete directory?"] 02645 } else { 02646 set question [msgcat::mc "Delete directories?"] 02647 } 02648 set detail [msgcat::mc "This operation cannot be undone"] 02649 02650 if {$opts(-test) || ([tk_messageBox -parent . -type yesno -default yes -message $question -detail $detail] eq "yes")} { 02651 02652 foreach row [lreverse $rows] { 02653 02654 # Get the directory pathname 02655 set dirpath [$widgets(tl) set $row name] 02656 02657 # Get the remote value 02658 set remote [$widgets(tl) set $row remote] 02659 02660 # Delete the folder 02661 files::delete_folder $dirpath $remote 02662 02663 # Remove the directory from the file browser 02664 $widgets(tl) delete $row 02665 02666 } 02667 02668 } 02669 02670 } 02671 02672 ###################################################################### 02673 # Causes the given folder/file to become a favorite. 02674 proc favorite {row} { 02675 02676 variable widgets 02677 02678 # Set the folder to be a favorite 02679 favorites::add [$widgets(tl) set $row name] 02680 02681 } 02682 02683 ###################################################################### 02684 # Causes the given folder/file to become a non-favorite. 02685 proc unfavorite {row} { 02686 02687 variable widgets 02688 02689 # Remove the folder from the favorites list 02690 favorites::remove [$widgets(tl) set $row name] 02691 02692 } 02693 02694 ###################################################################### 02695 # Removes the specified folder rows from the sidebar. 02696 proc remove_folder {rows} { 02697 02698 variable widgets 02699 02700 # Delete the row and its children 02701 $widgets(tl) delete $rows 02702 02703 # Update the information panel 02704 update_info_panel 02705 02706 } 02707 02708 ###################################################################### 02709 # Removes the parent(s) of the specified folder from the sidebar. 02710 proc remove_parent_folder {row} { 02711 02712 variable widgets 02713 02714 # Find the child index of the ancestor of the root 02715 set child $row 02716 while {[set parent [$widgets(tl) parent $child]] ne ""} { 02717 set child $parent 02718 } 02719 02720 # Move the row to root 02721 $widgets(tl) move $row "" [$widgets(tl) index $child] 02722 02723 # Delete the child tree 02724 $widgets(tl) delete $child 02725 02726 # Update the information panel 02727 update_info_panel 02728 02729 } 02730 02731 ###################################################################### 02732 # Sets the currently selected directory to the working directory. 02733 proc set_current_working_directory {row} { 02734 02735 variable widgets 02736 02737 # Set the current working directory to the selected pathname 02738 cd [$widgets(tl) set $row name] 02739 02740 # Update the UI 02741 gui::set_title 02742 02743 } 02744 02745 ###################################################################### 02746 # Refreshes the specified directory contents. 02747 proc refresh_directory_files {rows} { 02748 02749 variable widgets 02750 02751 foreach row [lreverse $rows] { 02752 expand_directory $row 02753 } 02754 02755 } 02756 02757 ###################################################################### 02758 # Adds the parent directory to the sidebar of the currently selected 02759 # row. 02760 proc add_parent_directory {row} { 02761 02762 variable widgets 02763 02764 # Get the remote value of the selected row 02765 set dname [file dirname [$widgets(tl) set $row name]] 02766 set remote [$widgets(tl) set $row remote] 02767 02768 # Add the parent directory to the sidebar 02769 add_directory $dname -remote $remote 02770 02771 } 02772 02773 ###################################################################### 02774 # Opens the currently selected file in the notebook. 02775 proc open_file {rows} { 02776 02777 variable widgets 02778 02779 set tab "" 02780 02781 # Add the files to the notebook 02782 foreach row $rows { 02783 set tab [gui::add_file end [$widgets(tl) set $row name] -lazy 1 -remote [$widgets(tl) set $row remote]] 02784 } 02785 02786 # Make the last tab visible 02787 if {$tab ne ""} { 02788 gui::set_current_tab [gui::get_info $tab tab tabbar] $tab 02789 } 02790 02791 } 02792 02793 ###################################################################### 02794 # Opens the file difference view for the specified file. 02795 proc show_file_diff {row} { 02796 02797 variable widgets 02798 02799 # Add the file to the notebook in difference view 02800 gui::add_file end [$widgets(tl) set $row name] -diff 1 -other [preferences::get View/ShowDifferenceInOtherPane] 02801 02802 } 02803 02804 ###################################################################### 02805 # Closes the specified file in the notebook. 02806 proc close_file {rows} { 02807 02808 variable widgets 02809 02810 set indices [list] 02811 02812 # Gather all of the opened filenames 02813 foreach row $rows { 02814 if {[$widgets(tl) item $row -image] ne ""} { 02815 lappend indices [files::get_index [$widgets(tl) set $row name] [$widgets(tl) set $row remote]] 02816 } 02817 } 02818 02819 # Close the tab at the current location 02820 gui::close_files $indices 02821 02822 } 02823 02824 ###################################################################### 02825 # Hides the specified files. 02826 proc hide_file {rows} { 02827 02828 variable widgets 02829 02830 set indices [list] 02831 02832 # Gather all of the opened filenames 02833 foreach row $rows { 02834 if {[$widgets(tl) item $row -image] ne ""} { 02835 lappend indices [files::get_index [$widgets(tl) set $row name] [$widgets(tl) set $row remote]] 02836 } 02837 } 02838 02839 # Hide the tab at the current location 02840 gui::hide_files $indices 02841 02842 } 02843 02844 ###################################################################### 02845 # Shows the files at the given row. 02846 proc show_file {rows} { 02847 02848 variable widgets 02849 02850 set indices [list] 02851 02852 # Gather all the opened filenames 02853 foreach row $rows { 02854 if {[$widgets(tl) item $row -image] ne ""} { 02855 lappend indices [files::get_index [$widgets(tl) set $row name] [$widgets(tl) set $row remote]] 02856 } 02857 } 02858 02859 # Show the tabs with the given filenames 02860 gui::show_files $indices 02861 02862 } 02863 02864 ###################################################################### 02865 # Allow the user to rename the currently selected file in the file 02866 # browser. 02867 proc rename_file {row args} { 02868 02869 variable widgets 02870 02871 array set opts { 02872 -testname "" 02873 } 02874 array set opts $args 02875 02876 # Get the current name 02877 set old_name [set new_name [$widgets(tl) set $row name]] 02878 set selrange [utils::basename_range $new_name] 02879 02880 # Get the remote status 02881 set remote [$widgets(tl) set $row remote] 02882 02883 # Get the new name from the user 02884 if {($opts(-testname) ne "") || [gui::get_user_response [msgcat::mc "File Name:"] new_name -allow_vars 1 -selrange $selrange]} { 02885 02886 if {$opts(-testname) ne ""} { 02887 set new_name $opts(-testname) 02888 } 02889 02890 # If the value of the cell hasn't changed or is empty, do nothing else. 02891 if {($old_name eq $new_name) || ($new_name eq "")} { 02892 return 02893 } 02894 02895 if {[catch { files::rename_file $old_name $new_name $remote } new_name]} { 02896 gui::set_error_message [msgcat::mc "Unable to rename file"] $new_name 02897 return 02898 } 02899 02900 # Add the file directory 02901 update_directory [add_directory [file dirname $new_name] -remote $remote] 02902 02903 # Update the old directory, if necessary 02904 if {[$widgets(tl) exists $row] && ([file dirname $old_name] ne [file dirname $new_name])} { 02905 update_directory [$widgets(tl) parent $row] 02906 } 02907 02908 } 02909 02910 } 02911 02912 ###################################################################### 02913 # Creates a duplicate of the specified file, adds it to the 02914 # sideband and allows the user to modify its name. 02915 proc duplicate_file {row} { 02916 02917 variable widgets 02918 02919 # Get the filename of the current selection 02920 set fname [$widgets(tl) set $row name] 02921 02922 # Get the remote indicator 02923 set remote [$widgets(tl) set $row remote] 02924 02925 # Create the default name of the duplicate file 02926 if {[catch { files::duplicate_file $fname $remote } dup_fname]} { 02927 gui::set_error_message [msgcat::mc "Unable to duplicate file"] $dup_fname 02928 return 02929 } 02930 02931 # Add the file to the sidebar just below the row 02932 set new_row [$widgets(tl) insert [$widgets(tl) parent $row] [expr [$widgets(tl) index $row] + 1] \ 02933 -text [file tail $dup_fname] -values [list $dup_fname $remote ""] -open 1 -tags [list f $dup_fname,$remote]] 02934 02935 } 02936 02937 ###################################################################### 02938 # Moves the given files/folders to the trash. 02939 proc move_to_trash {rows} { 02940 02941 variable widgets 02942 02943 set status 1 02944 set fnames [list] 02945 set isdir 0 02946 02947 if {[preferences::get General/ConfirmMoveToTrash]} { 02948 if {[llength $rows] == 1} { 02949 set question [msgcat::mc "Move selected item to trash?"] 02950 } else { 02951 set question [msgcat::mc "Move selected items to trash?"] 02952 } 02953 set detail [msgcat::mc "Files can be restored from the trash directory"] 02954 if {[tk_messageBox -parent . -type yesno -default yes -message $question -detail $detail] ne "yes"} { 02955 return 02956 } 02957 } 02958 02959 foreach row [lreverse $rows] { 02960 02961 # Get the full pathname 02962 set fname [$widgets(tl) set $row name] 02963 set isdir [file isdirectory $fname] 02964 02965 # Move the file to the trash 02966 if {[catch { files::move_to_trash $fname $isdir } rc]} { 02967 continue 02968 } 02969 02970 # Delete the row in the table 02971 $widgets(tl) delete $row 02972 02973 } 02974 02975 } 02976 02977 ###################################################################### 02978 # Deletes the specified file. 02979 proc delete_file {rows args} { 02980 02981 variable widgets 02982 02983 array set opts { 02984 -test 0 02985 } 02986 array set opts $args 02987 02988 if {[llength $rows] == 1} { 02989 set question [msgcat::mc "Delete file?"] 02990 } else { 02991 set question [msgcat::mc "Delete files?"] 02992 } 02993 set detail [msgcat::mc "This operation cannot be undone"] 02994 02995 # Get confirmation from the user 02996 if {$opts(-test) || ([tk_messageBox -parent . -type yesno -default yes -message $question -detail $detail] eq "yes")} { 02997 02998 foreach row [lreverse $rows] { 02999 03000 # Get the full pathname and remote status 03001 set fname [$widgets(tl) set $row name] 03002 set remote [$widgets(tl) set $row remote] 03003 03004 # Delete the file 03005 if {[catch { files::delete_file $fname $remote } rc]} { 03006 continue 03007 } 03008 03009 # Delete the row in the table 03010 $widgets(tl) delete $row 03011 03012 } 03013 03014 } 03015 03016 } 03017 03018 ###################################################################### 03019 # Handle any changes to the ignore file patterns/executables preference variables. 03020 proc handle_ignore_files {name1 name2 op} { 03021 03022 # Update all of the top-level directories 03023 update_directory_recursively "" 03024 03025 } 03026 03027 ###################################################################### 03028 # Handles the file information view option. 03029 proc handle_info_panel_view {name1 name2 op} { 03030 03031 update_info_panel 03032 03033 } 03034 03035 ###################################################################### 03036 # Handles any changes to the info panel update preference option. 03037 proc handle_info_panel_follows {name1 name2 op} { 03038 03039 update_info_panel_for_selection 03040 03041 } 03042 03043 ###################################################################### 03044 # Returns the list of files that are currently visible. 03045 proc get_shown_files {} { 03046 03047 variable widgets 03048 03049 set files [list] 03050 03051 foreach row [$widgets(tl) tag has f] { 03052 lappend files [list [$widgets(tl) set $row name] $row] 03053 } 03054 03055 return $files 03056 03057 } 03058 03059 ###################################################################### 03060 # Returns a list of files specifically for use in the "find in files" 03061 # function. 03062 proc get_fif_files {} { 03063 03064 variable widgets 03065 03066 set fif_files [list] 03067 set odirs [list] 03068 set ofiles [list] 03069 03070 # Gather the lists of files, opened files and opened directories 03071 foreach row [$widgets(tl) tag has d] { 03072 if {[$widgets(tl) set $row remote] eq ""} { 03073 set name [$widgets(tl) set $row name] 03074 if {[$widgets(tl) item $row -open] || ([$widgets(tl) parent $row] eq "")} { 03075 lappend odirs $name 03076 } 03077 lappend fif_files [list $name $name] 03078 } 03079 } 03080 foreach row [$widgets(tl) tag has f] { 03081 if {[$widgets(tl) set $row remote] eq ""} { 03082 set name [$widgets(tl) set $row name] 03083 if {[$widgets(tl) item $row -image] ne ""} { 03084 lappend ofiles $name 03085 } 03086 lappend fif_files [list $name $name] 03087 } 03088 } 03089 03090 # Add the favorites list 03091 foreach favorite [favorites::get_list] { 03092 if {[lsearch -index 1 $fif_files $favorite] == -1} { 03093 lappend fif_files [list $favorite $favorite] 03094 } 03095 } 03096 03097 # Add the Opened files/directories 03098 if {[llength $ofiles] > 0} { 03099 lappend fif_files [list {Opened Files} $ofiles] 03100 } 03101 if {[llength $odirs] > 0} { 03102 lappend fif_files [list {Opened Directories} $odirs] 03103 } 03104 lappend fif_files [list {Current Directory} [pwd]] 03105 03106 return [lsort -index 0 $fif_files] 03107 03108 } 03109 03110 ###################################################################### 03111 # Shows the given filename in the sidebar browser. Adds parent 03112 # directory if the file does not exist in the sidebar. 03113 proc view_file {fname {remote ""}} { 03114 03115 variable widgets 03116 03117 # Find the item. If it is not found, add its directory. 03118 if {[set found [$widgets(tl) tag has $fname,$remote]] eq ""} { 03119 add_directory [file dirname $fname] -remote $remote 03120 set found [$widgets(tl) tag has $fname,$remote] 03121 } 03122 03123 # Put the file into view 03124 $widgets(tl) selection set $found 03125 $widgets(tl) see $found 03126 03127 } 03128 03129 ###################################################################### 03130 # If value is set to 1, the sidebar will be transformed into a draggable 03131 # mode of operation. If value is set to 0, the sidebar will return to 03132 # normal mode of operation. 03133 proc set_draggable {value} { 03134 03135 variable widgets 03136 03137 $widgets(tl) configure -customdragsource $value 03138 03139 } 03140 03141 ###################################################################### 03142 # In cases where we are updating the information panel whenever the 03143 # user changes the selection, we need to make sure the sidebar selection 03144 # can change without delay since updating file information can take a 03145 # moment. 03146 proc update_info_panel_for_selection {} { 03147 03148 variable widgets 03149 variable ipanel_id 03150 03151 if {![preferences::get Sidebar/InfoPanelFollowsSelection]} { 03152 return 03153 } 03154 03155 if {$ipanel_id ne ""} { 03156 after cancel $ipanel_id 03157 } 03158 03159 # Update the information panel 03160 set ipanel_id [after 500 [list sidebar::update_info_panel [$widgets(tl) selection]]] 03161 03162 } 03163 03164 ###################################################################### 03165 # Updates the file information panel to match the current selections 03166 proc update_info_panel {{selected ""}} { 03167 03168 variable widgets 03169 variable ipanel_id 03170 03171 set ipanel_id "" 03172 03173 if {[llength $selected] == 1} { 03174 ipanel::update $widgets(info,panel) [$widgets(tl) set [lindex $selected 0] name] 03175 pack $widgets(info) -fill both 03176 $widgets(tl) see [lindex $selected 0] 03177 } elseif {($selected eq "") && [winfo ismapped $widgets(info)]} { 03178 ipanel::update $widgets(info,panel) 03179 } 03180 03181 } 03182 03183 ###################################################################### 03184 # If the information panel is open and displaying the given file, 03185 # update the information panel contents. 03186 proc update_info_panel_for_file {fname remote} { 03187 03188 variable widgets 03189 03190 # If the given file doesn't exist in the sidebar or the information panel 03191 # does not exist, return immediately. 03192 if {![winfo ismapped $widgets(info)] || ($remote ne "") || ([set index [get_index $fname $remote]] eq "")} { 03193 return 03194 } 03195 03196 # If the given filename matches the update info panel, update the information 03197 # in the info panel. 03198 ipanel::update $widgets(info,panel) 03199 03200 } 03201 03202 ###################################################################### 03203 # Closes the information panel. 03204 proc close_info_panel {fname} { 03205 03206 variable widgets 03207 03208 # Close the information panel content 03209 ipanel::close $widgets(info,panel) 03210 03211 # Remove the panel from view 03212 pack forget $widgets(info) 03213 03214 } 03215 03216 ###################################################################### 03217 # Writes the sorted contents of the given parent directory in the 03218 # sidebar to the parent's directory so that TKE will remember the 03219 # current sorting. 03220 proc write_sort_file {parent {use 1}} { 03221 03222 variable widgets 03223 03224 # Get the parent directory pathname 03225 set parentdir [$widgets(tl) set $parent name] 03226 03227 # Gather the list of items in the parent 03228 set items [list] 03229 foreach child [$widgets(tl) children $parent] { 03230 lappend items [file tail [$widgets(tl) set $child name]] 03231 } 03232 03233 # Write the file 03234 catch { tkedat::write [file join $parentdir .tkesort] [list items $items use $use] 0 } 03235 03236 } 03237 03238 ###################################################################### 03239 # Gets the default sortby state for the given directory. 03240 proc get_default_sortby {dir} { 03241 03242 variable widgets 03243 03244 if {![catch { tkedat::read [file join $dir .tkesort] } rc]} { 03245 array set contents $rc 03246 if {![info exists contents(use)] || $contents(use)} { 03247 return "manual" 03248 } 03249 } 03250 03251 return "name:-increasing" 03252 03253 } 03254 03255 }