git.oblomov.eu Git - git/blob - git-gui/lib/index.tcl

   1 # git-gui index (add/remove) support
   2 # Copyright (C) 2006, 2007 Shawn Pearce
   3
   4 proc _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
  10 proc 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
  19 proc _close_updateindex {fd} {
  20         fconfigure $fd -blocking 1
  21         close $fd
  22 }
  23
  24 proc 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
  66 proc 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
  96 proc 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
 135 proc 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
 165 proc 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
 209 proc 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
 246 proc 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
 291 proc 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
 321 proc 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
 335 proc 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
 373 proc 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
 387 proc 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".
 424 proc lambda {arguments body args} {
 425         return [list ::apply [list $arguments $body] {*}$args]
 426 }
 427
 428 proc 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.
 584 proc 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.
 607 proc 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
 691 proc 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.
 700 proc 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.
 709 proc 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
 723 proc 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
 737 proc 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 }