1# git-gui index (add/remove) support 2# Copyright (C) 2006, 2007 Shawn Pearce 3 4proc _delete_indexlock {} { 5 if {[catch {file delete -- [gitdir index.lock]} err]} { 6 error_popup [strcat [mc "Unable to unlock the index."] "\n\n$err"] 7 } 8} 9 10proc close_and_unlock_index {fd after} { 11 if {![catch {_close_updateindex $fd} err]} { 12 unlock_index 13 uplevel #0 $after 14 } else { 15 rescan_on_error $err $after 16 } 17} 18 19proc _close_updateindex {fd} { 20 fconfigure $fd -blocking 1 21 close $fd 22} 23 24proc rescan_on_error {err {after {}}} { 25 global use_ttk NS 26 27 set w .indexfried 28 Dialog $w 29 wm withdraw $w 30 wm title $w [strcat "[appname] ([reponame]): " [mc "Index Error"]] 31 wm geometry $w "+[winfo rootx .]+[winfo rooty .]" 32 set s [mc "Updating the Git index failed. A rescan will be automatically started to resynchronize git-gui."] 33 text $w.msg -yscrollcommand [list $w.vs set] \ 34 -width [string length $s] -relief flat \ 35 -borderwidth 0 -highlightthickness 0 \ 36 -background [get_bg_color $w] 37 $w.msg tag configure bold -font font_uibold -justify center 38 ${NS}::scrollbar $w.vs -command [list $w.msg yview] 39 $w.msg insert end $s bold \n\n$err {} 40 $w.msg configure -state disabled 41 42 ${NS}::button $w.continue \ 43 -text [mc "Continue"] \ 44 -command [list destroy $w] 45 ${NS}::button $w.unlock \ 46 -text [mc "Unlock Index"] \ 47 -command "destroy $w; _delete_indexlock" 48 grid $w.msg - $w.vs -sticky news 49 grid $w.unlock $w.continue - -sticky se -padx 2 -pady 2 50 grid columnconfigure $w 0 -weight 1 51 grid rowconfigure $w 0 -weight 1 52 53 wm protocol $w WM_DELETE_WINDOW update 54 bind $w.continue <Visibility> " 55 grab $w 56 focus %W 57 " 58 wm deiconify $w 59 tkwait window $w 60 61 $::main_status stop_all 62 unlock_index 63 rescan [concat $after {ui_ready;}] 0 64} 65 66proc update_indexinfo {msg path_list after} { 67 global update_index_cp 68 69 if {![lock_index update]} return 70 71 set update_index_cp 0 72 set path_list [lsort $path_list] 73 set total_cnt [llength $path_list] 74 set batch [expr {int($total_cnt * .01) + 1}] 75 if {$batch > 25} {set batch 25} 76 77 set status_bar_operation [$::main_status start $msg [mc "files"]] 78 set fd [git_write update-index -z --index-info] 79 fconfigure $fd \ 80 -blocking 0 \ 81 -buffering full \ 82 -buffersize 512 \ 83 -encoding binary \ 84 -translation binary 85 fileevent $fd writable [list \ 86 write_update_indexinfo \ 87 $fd \ 88 $path_list \ 89 $total_cnt \ 90 $batch \ 91 $status_bar_operation \ 92 $after \ 93 ] 94} 95 96proc write_update_indexinfo {fd path_list total_cnt batch status_bar_operation \ 97 after} { 98 global update_index_cp 99 global file_states current_diff_path 100 101 if {$update_index_cp >= $total_cnt} { 102 $status_bar_operation stop 103 close_and_unlock_index $fd $after 104 return 105 } 106 107 for {set i $batch} \ 108 {$update_index_cp < $total_cnt && $i > 0} \ 109 {incr i -1} { 110 set path [lindex $path_list $update_index_cp] 111 incr update_index_cp 112 113 set s $file_states($path) 114 switch -glob -- [lindex $s 0] { 115 A? {set new _O} 116 MT - 117 TM - 118 T_ {set new _T} 119 M? {set new _M} 120 TD - 121 D_ {set new _D} 122 D? {set new _?} 123 ?? {continue} 124 } 125 set info [lindex $s 2] 126 if {$info eq {}} continue 127 128 puts -nonewline $fd "$info\t[encoding convertto utf-8 $path]\0" 129 display_file $path $new 130 } 131 132 $status_bar_operation update $update_index_cp $total_cnt 133} 134 135proc update_index {msg path_list after} { 136 global update_index_cp 137 138 if {![lock_index update]} return 139 140 set update_index_cp 0 141 set path_list [lsort $path_list] 142 set total_cnt [llength $path_list] 143 set batch [expr {int($total_cnt * .01) + 1}] 144 if {$batch > 25} {set batch 25} 145 146 set status_bar_operation [$::main_status start $msg [mc "files"]] 147 set fd [git_write update-index --add --remove -z --stdin] 148 fconfigure $fd \ 149 -blocking 0 \ 150 -buffering full \ 151 -buffersize 512 \ 152 -encoding binary \ 153 -translation binary 154 fileevent $fd writable [list \ 155 write_update_index \ 156 $fd \ 157 $path_list \ 158 $total_cnt \ 159 $batch \ 160 $status_bar_operation \ 161 $after \ 162 ] 163} 164 165proc write_update_index {fd path_list total_cnt batch status_bar_operation \ 166 after} { 167 global update_index_cp 168 global file_states current_diff_path 169 170 if {$update_index_cp >= $total_cnt} { 171 $status_bar_operation stop 172 close_and_unlock_index $fd $after 173 return 174 } 175 176 for {set i $batch} \ 177 {$update_index_cp < $total_cnt && $i > 0} \ 178 {incr i -1} { 179 set path [lindex $path_list $update_index_cp] 180 incr update_index_cp 181 182 switch -glob -- [lindex $file_states($path) 0] { 183 AD {set new __} 184 ?D {set new D_} 185 _O - 186 AT - 187 AM {set new A_} 188 TM - 189 MT - 190 _T {set new T_} 191 _U - 192 U? { 193 if {[file exists $path]} { 194 set new M_ 195 } else { 196 set new D_ 197 } 198 } 199 ?M {set new M_} 200 ?? {continue} 201 } 202 puts -nonewline $fd "[encoding convertto utf-8 $path]\0" 203 display_file $path $new 204 } 205 206 $status_bar_operation update $update_index_cp $total_cnt 207} 208 209proc checkout_index {msg path_list after capture_error} { 210 global update_index_cp 211 212 if {![lock_index update]} return 213 214 set update_index_cp 0 215 set path_list [lsort $path_list] 216 set total_cnt [llength $path_list] 217 set batch [expr {int($total_cnt * .01) + 1}] 218 if {$batch > 25} {set batch 25} 219 220 set status_bar_operation [$::main_status start $msg [mc "files"]] 221 set fd [git_write checkout-index \ 222 --index \ 223 --quiet \ 224 --force \ 225 -z \ 226 --stdin \ 227 ] 228 fconfigure $fd \ 229 -blocking 0 \ 230 -buffering full \ 231 -buffersize 512 \ 232 -encoding binary \ 233 -translation binary 234 fileevent $fd writable [list \ 235 write_checkout_index \ 236 $fd \ 237 $path_list \ 238 $total_cnt \ 239 $batch \ 240 $status_bar_operation \ 241 $after \ 242 $capture_error \ 243 ] 244} 245 246proc write_checkout_index {fd path_list total_cnt batch status_bar_operation \ 247 after capture_error} { 248 global update_index_cp 249 global file_states current_diff_path 250 251 if {$update_index_cp >= $total_cnt} { 252 $status_bar_operation stop 253 254 # We do not unlock the index directly here because this 255 # operation expects to potentially run in parallel with file 256 # deletions scheduled by revert_helper. We're done with the 257 # update index, so we close it, but actually unlocking the index 258 # and dealing with potential errors is deferred to the chord 259 # body that runs when all async operations are completed. 260 # 261 # (See after_chord in revert_helper.) 262 263 if {[catch {_close_updateindex $fd} err]} { 264 uplevel #0 $capture_error [list $err] 265 } 266 267 uplevel #0 $after 268 269 return 270 } 271 272 for {set i $batch} \ 273 {$update_index_cp < $total_cnt && $i > 0} \ 274 {incr i -1} { 275 set path [lindex $path_list $update_index_cp] 276 incr update_index_cp 277 switch -glob -- [lindex $file_states($path) 0] { 278 U? {continue} 279 ?M - 280 ?T - 281 ?D { 282 puts -nonewline $fd "[encoding convertto utf-8 $path]\0" 283 display_file $path ?_ 284 } 285 } 286 } 287 288 $status_bar_operation update $update_index_cp $total_cnt 289} 290 291proc unstage_helper {txt paths} { 292 global file_states current_diff_path 293 294 if {![lock_index begin-update]} return 295 296 set path_list [list] 297 set after {} 298 foreach path $paths { 299 switch -glob -- [lindex $file_states($path) 0] { 300 A? - 301 M? - 302 T? - 303 D? { 304 lappend path_list $path 305 if {$path eq $current_diff_path} { 306 set after {reshow_diff;} 307 } 308 } 309 } 310 } 311 if {$path_list eq {}} { 312 unlock_index 313 } else { 314 update_indexinfo \ 315 $txt \ 316 $path_list \ 317 [concat $after {ui_ready;}] 318 } 319} 320 321proc do_unstage_selection {} { 322 global current_diff_path selected_paths 323 324 if {[array size selected_paths] > 0} { 325 unstage_helper \ 326 [mc "Unstaging selected files from commit"] \ 327 [array names selected_paths] 328 } elseif {$current_diff_path ne {}} { 329 unstage_helper \ 330 [mc "Unstaging %s from commit" [short_path $current_diff_path]] \ 331 [list $current_diff_path] 332 } 333} 334 335proc add_helper {txt paths} { 336 global file_states current_diff_path 337 338 if {![lock_index begin-update]} return 339 340 set path_list [list] 341 set after {} 342 foreach path $paths { 343 switch -glob -- [lindex $file_states($path) 0] { 344 _U - 345 U? { 346 if {$path eq $current_diff_path} { 347 unlock_index 348 merge_stage_workdir $path 349 return 350 } 351 } 352 _O - 353 ?M - 354 ?D - 355 ?T { 356 lappend path_list $path 357 if {$path eq $current_diff_path} { 358 set after {reshow_diff;} 359 } 360 } 361 } 362 } 363 if {$path_list eq {}} { 364 unlock_index 365 } else { 366 update_index \ 367 $txt \ 368 $path_list \ 369 [concat $after {ui_status [mc "Ready to commit."];}] 370 } 371} 372 373proc do_add_selection {} { 374 global current_diff_path selected_paths 375 376 if {[array size selected_paths] > 0} { 377 add_helper \ 378 [mc "Adding selected files"] \ 379 [array names selected_paths] 380 } elseif {$current_diff_path ne {}} { 381 add_helper \ 382 [mc "Adding %s" [short_path $current_diff_path]] \ 383 [list $current_diff_path] 384 } 385} 386 387proc do_add_all {} { 388 global file_states 389 390 set paths [list] 391 set untracked_paths [list] 392 foreach path [array names file_states] { 393 switch -glob -- [lindex $file_states($path) 0] { 394 U? {continue} 395 ?M - 396 ?T - 397 ?D {lappend paths $path} 398 ?O {lappend untracked_paths $path} 399 } 400 } 401 if {[llength $untracked_paths]} { 402 set reply 0 403 switch -- [get_config gui.stageuntracked] { 404 no { 405 set reply 0 406 } 407 yes { 408 set reply 1 409 } 410 ask - 411 default { 412 set reply [ask_popup [mc "Stage %d untracked files?" \ 413 [llength $untracked_paths]]] 414 } 415 } 416 if {$reply} { 417 set paths [concat $paths $untracked_paths] 418 } 419 } 420 add_helper [mc "Adding all changed files"] $paths 421} 422 423# Copied from TclLib package "lambda". 424proc lambda {arguments body args} { 425 return [list ::apply [list $arguments $body] {*}$args] 426} 427 428proc revert_helper {txt paths} { 429 global file_states current_diff_path 430 431 if {![lock_index begin-update]} return 432 433 # Common "after" functionality that waits until multiple asynchronous 434 # operations are complete (by waiting for them to activate their notes 435 # on the chord). 436 # 437 # The asynchronous operations are each indicated below by a comment 438 # before the code block that starts the async operation. 439 set after_chord [SimpleChord::new { 440 if {[string trim $err] != ""} { 441 rescan_on_error $err 442 } else { 443 unlock_index 444 if {$should_reshow_diff} { reshow_diff } 445 ui_ready 446 } 447 }] 448 449 $after_chord eval { set should_reshow_diff 0 } 450 451 # This function captures an error for processing when after_chord is 452 # completed. (The chord is curried into the lambda function.) 453 set capture_error [lambda \ 454 {chord error} \ 455 { $chord eval [list set err $error] } \ 456 $after_chord] 457 458 # We don't know how many notes we're going to create (it's dynamic based 459 # on conditional paths below), so create a common note that will delay 460 # the chord's completion until we activate it, and then activate it 461 # after all the other notes have been created. 462 set after_common_note [$after_chord add_note] 463 464 set path_list [list] 465 set untracked_list [list] 466 467 foreach path $paths { 468 switch -glob -- [lindex $file_states($path) 0] { 469 U? {continue} 470 ?O { 471 lappend untracked_list $path 472 } 473 ?M - 474 ?T - 475 ?D { 476 lappend path_list $path 477 if {$path eq $current_diff_path} { 478 $after_chord eval { set should_reshow_diff 1 } 479 } 480 } 481 } 482 } 483 484 set path_cnt [llength $path_list] 485 set untracked_cnt [llength $untracked_list] 486 487 # Asynchronous operation: revert changes by checking them out afresh 488 # from the index. 489 if {$path_cnt > 0} { 490 # Split question between singular and plural cases, because 491 # such distinction is needed in some languages. Previously, the 492 # code used "Revert changes in" for both, but that can't work 493 # in languages where 'in' must be combined with word from 494 # rest of string (in different way for both cases of course). 495 # 496 # FIXME: Unfortunately, even that isn't enough in some languages 497 # as they have quite complex plural-form rules. Unfortunately, 498 # msgcat doesn't seem to support that kind of string 499 # translation. 500 # 501 if {$path_cnt == 1} { 502 set query [mc \ 503 "Revert changes in file %s?" \ 504 [short_path [lindex $path_list]] \ 505 ] 506 } else { 507 set query [mc \ 508 "Revert changes in these %i files?" \ 509 $path_cnt] 510 } 511 512 set reply [tk_dialog \ 513 .confirm_revert \ 514 "[appname] ([reponame])" \ 515 "$query 516 517[mc "Any unstaged changes will be permanently lost by the revert."]" \ 518 question \ 519 1 \ 520 [mc "Do Nothing"] \ 521 [mc "Revert Changes"] \ 522 ] 523 524 if {$reply == 1} { 525 set note [$after_chord add_note] 526 checkout_index \ 527 $txt \ 528 $path_list \ 529 [list $note activate] \ 530 $capture_error 531 } 532 } 533 534 # Asynchronous operation: Deletion of untracked files. 535 if {$untracked_cnt > 0} { 536 # Split question between singular and plural cases, because 537 # such distinction is needed in some languages. 538 # 539 # FIXME: Unfortunately, even that isn't enough in some languages 540 # as they have quite complex plural-form rules. Unfortunately, 541 # msgcat doesn't seem to support that kind of string 542 # translation. 543 # 544 if {$untracked_cnt == 1} { 545 set query [mc \ 546 "Delete untracked file %s?" \ 547 [short_path [lindex $untracked_list]] \ 548 ] 549 } else { 550 set query [mc \ 551 "Delete these %i untracked files?" \ 552 $untracked_cnt \ 553 ] 554 } 555 556 set reply [tk_dialog \ 557 .confirm_revert \ 558 "[appname] ([reponame])" \ 559 "$query 560 561[mc "Files will be permanently deleted."]" \ 562 question \ 563 1 \ 564 [mc "Do Nothing"] \ 565 [mc "Delete Files"] \ 566 ] 567 568 if {$reply == 1} { 569 $after_chord eval { set should_reshow_diff 1 } 570 571 set note [$after_chord add_note] 572 delete_files $untracked_list [list $note activate] 573 } 574 } 575 576 # Activate the common note. If no other notes were created, this 577 # completes the chord. If other notes were created, then this common 578 # note prevents a race condition where the chord might complete early. 579 $after_common_note activate 580} 581 582# Delete all of the specified files, performing deletion in batches to allow the 583# UI to remain responsive and updated. 584proc delete_files {path_list after} { 585 # Enable progress bar status updates 586 set status_bar_operation [$::main_status \ 587 start \ 588 [mc "Deleting"] \ 589 [mc "files"]] 590 591 set path_index 0 592 set deletion_errors [list] 593 set batch_size 50 594 595 delete_helper \ 596 $path_list \ 597 $path_index \ 598 $deletion_errors \ 599 $batch_size \ 600 $status_bar_operation \ 601 $after 602} 603 604# Helper function to delete a list of files in batches. Each call deletes one 605# batch of files, and then schedules a call for the next batch after any UI 606# messages have been processed. 607proc delete_helper {path_list path_index deletion_errors batch_size \ 608 status_bar_operation after} { 609 global file_states 610 611 set path_cnt [llength $path_list] 612 613 set batch_remaining $batch_size 614 615 while {$batch_remaining > 0} { 616 if {$path_index >= $path_cnt} { break } 617 618 set path [lindex $path_list $path_index] 619 620 set deletion_failed [catch {file delete -- $path} deletion_error] 621 622 if {$deletion_failed} { 623 lappend deletion_errors [list "$deletion_error"] 624 } else { 625 remove_empty_directories [file dirname $path] 626 627 # Don't assume the deletion worked. Remove the file from 628 # the UI, but only if it no longer exists. 629 if {![path_exists $path]} { 630 unset file_states($path) 631 display_file $path __ 632 } 633 } 634 635 incr path_index 1 636 incr batch_remaining -1 637 } 638 639 # Update the progress bar to indicate that this batch has been 640 # completed. The update will be visible when this procedure returns 641 # and allows the UI thread to process messages. 642 $status_bar_operation update $path_index $path_cnt 643 644 if {$path_index < $path_cnt} { 645 # The Tcler's Wiki lists this as the best practice for keeping 646 # a UI active and processing messages during a long-running 647 # operation. 648 649 after idle [list after 0 [list \ 650 delete_helper \ 651 $path_list \ 652 $path_index \ 653 $deletion_errors \ 654 $batch_size \ 655 $status_bar_operation \ 656 $after 657 ]] 658 } else { 659 # Finish the status bar operation. 660 $status_bar_operation stop 661 662 # Report error, if any, based on how many deletions failed. 663 set deletion_error_cnt [llength $deletion_errors] 664 665 if {($deletion_error_cnt > 0) 666 && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} { 667 set error_text [mc "Encountered errors deleting files:\n"] 668 669 foreach deletion_error $deletion_errors { 670 append error_text "* [lindex $deletion_error 0]\n" 671 } 672 673 error_popup $error_text 674 } elseif {$deletion_error_cnt == $path_cnt} { 675 error_popup [mc \ 676 "None of the %d selected files could be deleted." \ 677 $path_cnt \ 678 ] 679 } elseif {$deletion_error_cnt > 1} { 680 error_popup [mc \ 681 "%d of the %d selected files could not be deleted." \ 682 $deletion_error_cnt \ 683 $path_cnt \ 684 ] 685 } 686 687 uplevel #0 $after 688 } 689} 690 691proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; } 692 693# This function is from the TCL documentation: 694# 695# https://wiki.tcl-lang.org/page/file+exists 696# 697# [file exists] returns false if the path does exist but is a symlink to a path 698# that doesn't exist. This proc returns true if the path exists, regardless of 699# whether it is a symlink and whether it is broken. 700proc path_exists {name} { 701 expr {![catch {file lstat $name finfo}]} 702} 703 704# Remove as many empty directories as we can starting at the specified path, 705# walking up the directory tree. If we encounter a directory that is not 706# empty, or if a directory deletion fails, then we stop the operation and 707# return to the caller. Even if this procedure fails to delete any 708# directories at all, it does not report failure. 709proc remove_empty_directories {directory_path} { 710 set parent_path [file dirname $directory_path] 711 712 while {$parent_path != $directory_path} { 713 set contents [glob -nocomplain -dir $directory_path *] 714 715 if {[llength $contents] > 0} { break } 716 if {[catch {file delete -- $directory_path}]} { break } 717 718 set directory_path $parent_path 719 set parent_path [file dirname $directory_path] 720 } 721} 722 723proc do_revert_selection {} { 724 global current_diff_path selected_paths 725 726 if {[array size selected_paths] > 0} { 727 revert_helper \ 728 [mc "Reverting selected files"] \ 729 [array names selected_paths] 730 } elseif {$current_diff_path ne {}} { 731 revert_helper \ 732 [mc "Reverting %s" [short_path $current_diff_path]] \ 733 [list $current_diff_path] 734 } 735} 736 737proc do_select_commit_type {} { 738 global commit_type commit_type_is_amend 739 740 if {$commit_type_is_amend == 0 741 && [string match amend* $commit_type]} { 742 create_new_commit 743 } elseif {$commit_type_is_amend == 1 744 && ![string match amend* $commit_type]} { 745 load_last_commit 746 747 # The amend request was rejected... 748 # 749 if {![string match amend* $commit_type]} { 750 set commit_type_is_amend 0 751 } 752 } 753} 754