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 [list 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 [list 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 checkout_index \ 526 $txt \ 527 $path_list \ 528 [$after_chord add_note] \ 529 $capture_error 530 } 531 } 532 533 # Asynchronous operation: Deletion of untracked files. 534 if {$untracked_cnt > 0} { 535 # Split question between singular and plural cases, because 536 # such distinction is needed in some languages. 537 # 538 # FIXME: Unfortunately, even that isn't enough in some languages 539 # as they have quite complex plural-form rules. Unfortunately, 540 # msgcat doesn't seem to support that kind of string 541 # translation. 542 # 543 if {$untracked_cnt == 1} { 544 set query [mc \ 545 "Delete untracked file %s?" \ 546 [short_path [lindex $untracked_list]] \ 547 ] 548 } else { 549 set query [mc \ 550 "Delete these %i untracked files?" \ 551 $untracked_cnt \ 552 ] 553 } 554 555 set reply [tk_dialog \ 556 .confirm_revert \ 557 "[appname] ([reponame])" \ 558 "$query 559 560[mc "Files will be permanently deleted."]" \ 561 question \ 562 1 \ 563 [mc "Do Nothing"] \ 564 [mc "Delete Files"] \ 565 ] 566 567 if {$reply == 1} { 568 $after_chord eval { set should_reshow_diff 1 } 569 570 delete_files $untracked_list [$after_chord add_note] 571 } 572 } 573 574 # Activate the common note. If no other notes were created, this 575 # completes the chord. If other notes were created, then this common 576 # note prevents a race condition where the chord might complete early. 577 $after_common_note 578} 579 580# Delete all of the specified files, performing deletion in batches to allow the 581# UI to remain responsive and updated. 582proc delete_files {path_list after} { 583 # Enable progress bar status updates 584 set status_bar_operation [$::main_status \ 585 start \ 586 [mc "Deleting"] \ 587 [mc "files"]] 588 589 set path_index 0 590 set deletion_errors [list] 591 set batch_size 50 592 593 delete_helper \ 594 $path_list \ 595 $path_index \ 596 $deletion_errors \ 597 $batch_size \ 598 $status_bar_operation \ 599 $after 600} 601 602# Helper function to delete a list of files in batches. Each call deletes one 603# batch of files, and then schedules a call for the next batch after any UI 604# messages have been processed. 605proc delete_helper {path_list path_index deletion_errors batch_size \ 606 status_bar_operation after} { 607 global file_states 608 609 set path_cnt [llength $path_list] 610 611 set batch_remaining $batch_size 612 613 while {$batch_remaining > 0} { 614 if {$path_index >= $path_cnt} { break } 615 616 set path [lindex $path_list $path_index] 617 618 set deletion_failed [catch {file delete -- $path} deletion_error] 619 620 if {$deletion_failed} { 621 lappend deletion_errors [list "$deletion_error"] 622 } else { 623 remove_empty_directories [file dirname $path] 624 625 # Don't assume the deletion worked. Remove the file from 626 # the UI, but only if it no longer exists. 627 if {![path_exists $path]} { 628 unset file_states($path) 629 display_file $path __ 630 } 631 } 632 633 incr path_index 1 634 incr batch_remaining -1 635 } 636 637 # Update the progress bar to indicate that this batch has been 638 # completed. The update will be visible when this procedure returns 639 # and allows the UI thread to process messages. 640 $status_bar_operation update $path_index $path_cnt 641 642 if {$path_index < $path_cnt} { 643 # The Tcler's Wiki lists this as the best practice for keeping 644 # a UI active and processing messages during a long-running 645 # operation. 646 647 after idle [list after 0 [list \ 648 delete_helper \ 649 $path_list \ 650 $path_index \ 651 $deletion_errors \ 652 $batch_size \ 653 $status_bar_operation \ 654 $after 655 ]] 656 } else { 657 # Finish the status bar operation. 658 $status_bar_operation stop 659 660 # Report error, if any, based on how many deletions failed. 661 set deletion_error_cnt [llength $deletion_errors] 662 663 if {($deletion_error_cnt > 0) 664 && ($deletion_error_cnt <= [MAX_VERBOSE_FILES_IN_DELETION_ERROR])} { 665 set error_text [mc "Encountered errors deleting files:\n"] 666 667 foreach deletion_error $deletion_errors { 668 append error_text "* [lindex $deletion_error 0]\n" 669 } 670 671 error_popup $error_text 672 } elseif {$deletion_error_cnt == $path_cnt} { 673 error_popup [mc \ 674 "None of the %d selected files could be deleted." \ 675 $path_cnt \ 676 ] 677 } elseif {$deletion_error_cnt > 1} { 678 error_popup [mc \ 679 "%d of the %d selected files could not be deleted." \ 680 $deletion_error_cnt \ 681 $path_cnt \ 682 ] 683 } 684 685 uplevel #0 $after 686 } 687} 688 689proc MAX_VERBOSE_FILES_IN_DELETION_ERROR {} { return 10; } 690 691# This function is from the TCL documentation: 692# 693# https://wiki.tcl-lang.org/page/file+exists 694# 695# [file exists] returns false if the path does exist but is a symlink to a path 696# that doesn't exist. This proc returns true if the path exists, regardless of 697# whether it is a symlink and whether it is broken. 698proc path_exists {name} { 699 expr {![catch {file lstat $name finfo}]} 700} 701 702# Remove as many empty directories as we can starting at the specified path, 703# walking up the directory tree. If we encounter a directory that is not 704# empty, or if a directory deletion fails, then we stop the operation and 705# return to the caller. Even if this procedure fails to delete any 706# directories at all, it does not report failure. 707proc remove_empty_directories {directory_path} { 708 set parent_path [file dirname $directory_path] 709 710 while {$parent_path != $directory_path} { 711 set contents [glob -nocomplain -dir $directory_path *] 712 713 if {[llength $contents] > 0} { break } 714 if {[catch {file delete -- $directory_path}]} { break } 715 716 set directory_path $parent_path 717 set parent_path [file dirname $directory_path] 718 } 719} 720 721proc do_revert_selection {} { 722 global current_diff_path selected_paths 723 724 if {[array size selected_paths] > 0} { 725 revert_helper \ 726 [mc "Reverting selected files"] \ 727 [array names selected_paths] 728 } elseif {$current_diff_path ne {}} { 729 revert_helper \ 730 [mc "Reverting %s" [short_path $current_diff_path]] \ 731 [list $current_diff_path] 732 } 733} 734 735proc do_select_commit_type {} { 736 global commit_type commit_type_is_amend 737 738 if {$commit_type_is_amend == 0 739 && [string match amend* $commit_type]} { 740 create_new_commit 741 } elseif {$commit_type_is_amend == 1 742 && ![string match amend* $commit_type]} { 743 load_last_commit 744 745 # The amend request was rejected... 746 # 747 if {![string match amend* $commit_type]} { 748 set commit_type_is_amend 0 749 } 750 } 751} 752