Andrew's git / gitweb.git / git-gui.sh
?
git-gui.shon commit git-gui: Test for Cygwin differently than from Windows. (20ddfca)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5set appvers {@@GIT_VERSION@@}
   6set copyright {
   7Copyright © 2006, 2007 Shawn Pearce, Paul Mackerras.
   8
   9This program is free software; you can redistribute it and/or modify
  10it under the terms of the GNU General Public License as published by
  11the Free Software Foundation; either version 2 of the License, or
  12(at your option) any later version.
  13
  14This program is distributed in the hope that it will be useful,
  15but WITHOUT ANY WARRANTY; without even the implied warranty of
  16MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17GNU General Public License for more details.
  18
  19You should have received a copy of the GNU General Public License
  20along with this program; if not, write to the Free Software
  21Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22
  23######################################################################
  24##
  25## read only globals
  26
  27set _appname [lindex [file split $argv0] end]
  28set _gitdir {}
  29set _gitexec {}
  30set _reponame {}
  31set _iscygwin {}
  32
  33proc appname {} {
  34        global _appname
  35        return $_appname
  36}
  37
  38proc gitdir {args} {
  39        global _gitdir
  40        if {$args eq {}} {
  41                return $_gitdir
  42        }
  43        return [eval [concat [list file join $_gitdir] $args]]
  44}
  45
  46proc gitexec {args} {
  47        global _gitexec
  48        if {$_gitexec eq {}} {
  49                if {[catch {set _gitexec [exec git --exec-path]} err]} {
  50                        error "Git not installed?\n\n$err"
  51                }
  52        }
  53        if {$args eq {}} {
  54                return $_gitexec
  55        }
  56        return [eval [concat [list file join $_gitexec] $args]]
  57}
  58
  59proc reponame {} {
  60        global _reponame
  61        return $_reponame
  62}
  63
  64proc is_MacOSX {} {
  65        global tcl_platform tk_library
  66        if {[tk windowingsystem] eq {aqua}} {
  67                return 1
  68        }
  69        return 0
  70}
  71
  72proc is_Windows {} {
  73        global tcl_platform
  74        if {$tcl_platform(platform) eq {windows}} {
  75                return 1
  76        }
  77        return 0
  78}
  79
  80proc is_Cygwin {} {
  81        global tcl_platform _iscygwin
  82        if {$_iscygwin eq {}} {
  83                if {$tcl_platform(platform) eq {windows}} {
  84                        if {[catch {set p [exec cygpath --windir]} err]} {
  85                                set _iscygwin 0
  86                        } else {
  87                                set _iscygwin 1
  88                        }
  89                } else {
  90                        set _iscygwin 0
  91                }
  92        }
  93        return $_iscygwin
  94}
  95
  96######################################################################
  97##
  98## config
  99
 100proc is_many_config {name} {
 101        switch -glob -- $name {
 102        remote.*.fetch -
 103        remote.*.push
 104                {return 1}
 105        *
 106                {return 0}
 107        }
 108}
 109
 110proc is_config_true {name} {
 111        global repo_config
 112        if {[catch {set v $repo_config($name)}]} {
 113                return 0
 114        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 115                return 1
 116        } else {
 117                return 0
 118        }
 119}
 120
 121proc load_config {include_global} {
 122        global repo_config global_config default_config
 123
 124        array unset global_config
 125        if {$include_global} {
 126                catch {
 127                        set fd_rc [open "| git repo-config --global --list" r]
 128                        while {[gets $fd_rc line] >= 0} {
 129                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 130                                        if {[is_many_config $name]} {
 131                                                lappend global_config($name) $value
 132                                        } else {
 133                                                set global_config($name) $value
 134                                        }
 135                                }
 136                        }
 137                        close $fd_rc
 138                }
 139        }
 140
 141        array unset repo_config
 142        catch {
 143                set fd_rc [open "| git repo-config --list" r]
 144                while {[gets $fd_rc line] >= 0} {
 145                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 146                                if {[is_many_config $name]} {
 147                                        lappend repo_config($name) $value
 148                                } else {
 149                                        set repo_config($name) $value
 150                                }
 151                        }
 152                }
 153                close $fd_rc
 154        }
 155
 156        foreach name [array names default_config] {
 157                if {[catch {set v $global_config($name)}]} {
 158                        set global_config($name) $default_config($name)
 159                }
 160                if {[catch {set v $repo_config($name)}]} {
 161                        set repo_config($name) $default_config($name)
 162                }
 163        }
 164}
 165
 166proc save_config {} {
 167        global default_config font_descs
 168        global repo_config global_config
 169        global repo_config_new global_config_new
 170
 171        foreach option $font_descs {
 172                set name [lindex $option 0]
 173                set font [lindex $option 1]
 174                font configure $font \
 175                        -family $global_config_new(gui.$font^^family) \
 176                        -size $global_config_new(gui.$font^^size)
 177                font configure ${font}bold \
 178                        -family $global_config_new(gui.$font^^family) \
 179                        -size $global_config_new(gui.$font^^size)
 180                set global_config_new(gui.$name) [font configure $font]
 181                unset global_config_new(gui.$font^^family)
 182                unset global_config_new(gui.$font^^size)
 183        }
 184
 185        foreach name [array names default_config] {
 186                set value $global_config_new($name)
 187                if {$value ne $global_config($name)} {
 188                        if {$value eq $default_config($name)} {
 189                                catch {exec git repo-config --global --unset $name}
 190                        } else {
 191                                regsub -all "\[{}\]" $value {"} value
 192                                exec git repo-config --global $name $value
 193                        }
 194                        set global_config($name) $value
 195                        if {$value eq $repo_config($name)} {
 196                                catch {exec git repo-config --unset $name}
 197                                set repo_config($name) $value
 198                        }
 199                }
 200        }
 201
 202        foreach name [array names default_config] {
 203                set value $repo_config_new($name)
 204                if {$value ne $repo_config($name)} {
 205                        if {$value eq $global_config($name)} {
 206                                catch {exec git repo-config --unset $name}
 207                        } else {
 208                                regsub -all "\[{}\]" $value {"} value
 209                                exec git repo-config $name $value
 210                        }
 211                        set repo_config($name) $value
 212                }
 213        }
 214}
 215
 216proc error_popup {msg} {
 217        set title [appname]
 218        if {[reponame] ne {}} {
 219                append title " ([reponame])"
 220        }
 221        set cmd [list tk_messageBox \
 222                -icon error \
 223                -type ok \
 224                -title "$title: error" \
 225                -message $msg]
 226        if {[winfo ismapped .]} {
 227                lappend cmd -parent .
 228        }
 229        eval $cmd
 230}
 231
 232proc warn_popup {msg} {
 233        set title [appname]
 234        if {[reponame] ne {}} {
 235                append title " ([reponame])"
 236        }
 237        set cmd [list tk_messageBox \
 238                -icon warning \
 239                -type ok \
 240                -title "$title: warning" \
 241                -message $msg]
 242        if {[winfo ismapped .]} {
 243                lappend cmd -parent .
 244        }
 245        eval $cmd
 246}
 247
 248proc info_popup {msg {parent .}} {
 249        set title [appname]
 250        if {[reponame] ne {}} {
 251                append title " ([reponame])"
 252        }
 253        tk_messageBox \
 254                -parent $parent \
 255                -icon info \
 256                -type ok \
 257                -title $title \
 258                -message $msg
 259}
 260
 261proc ask_popup {msg} {
 262        set title [appname]
 263        if {[reponame] ne {}} {
 264                append title " ([reponame])"
 265        }
 266        return [tk_messageBox \
 267                -parent . \
 268                -icon question \
 269                -type yesno \
 270                -title $title \
 271                -message $msg]
 272}
 273
 274######################################################################
 275##
 276## repository setup
 277
 278if {   [catch {set _gitdir $env(GIT_DIR)}]
 279        && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 280        catch {wm withdraw .}
 281        error_popup "Cannot find the git directory:\n\n$err"
 282        exit 1
 283}
 284if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 285        catch {set _gitdir [exec cygpath --unix $_gitdir]}
 286}
 287if {![file isdirectory $_gitdir]} {
 288        catch {wm withdraw .}
 289        error_popup "Git directory not found:\n\n$_gitdir"
 290        exit 1
 291}
 292if {[lindex [file split $_gitdir] end] ne {.git}} {
 293        catch {wm withdraw .}
 294        error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 295        exit 1
 296}
 297if {[catch {cd [file dirname $_gitdir]} err]} {
 298        catch {wm withdraw .}
 299        error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 300        exit 1
 301}
 302set _reponame [lindex [file split \
 303        [file normalize [file dirname $_gitdir]]] \
 304        end]
 305
 306set single_commit 0
 307if {[appname] eq {git-citool}} {
 308        set single_commit 1
 309}
 310
 311######################################################################
 312##
 313## task management
 314
 315set rescan_active 0
 316set diff_active 0
 317set last_clicked {}
 318
 319set disable_on_lock [list]
 320set index_lock_type none
 321
 322proc lock_index {type} {
 323        global index_lock_type disable_on_lock
 324
 325        if {$index_lock_type eq {none}} {
 326                set index_lock_type $type
 327                foreach w $disable_on_lock {
 328                        uplevel #0 $w disabled
 329                }
 330                return 1
 331        } elseif {$index_lock_type eq "begin-$type"} {
 332                set index_lock_type $type
 333                return 1
 334        }
 335        return 0
 336}
 337
 338proc unlock_index {} {
 339        global index_lock_type disable_on_lock
 340
 341        set index_lock_type none
 342        foreach w $disable_on_lock {
 343                uplevel #0 $w normal
 344        }
 345}
 346
 347######################################################################
 348##
 349## status
 350
 351proc repository_state {ctvar hdvar mhvar} {
 352        global current_branch
 353        upvar $ctvar ct $hdvar hd $mhvar mh
 354
 355        set mh [list]
 356
 357        if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 358                set current_branch {}
 359        } else {
 360                regsub ^refs/((heads|tags|remotes)/)? \
 361                        $current_branch \
 362                        {} \
 363                        current_branch
 364        }
 365
 366        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 367                set hd {}
 368                set ct initial
 369                return
 370        }
 371
 372        set merge_head [gitdir MERGE_HEAD]
 373        if {[file exists $merge_head]} {
 374                set ct merge
 375                set fd_mh [open $merge_head r]
 376                while {[gets $fd_mh line] >= 0} {
 377                        lappend mh $line
 378                }
 379                close $fd_mh
 380                return
 381        }
 382
 383        set ct normal
 384}
 385
 386proc PARENT {} {
 387        global PARENT empty_tree
 388
 389        set p [lindex $PARENT 0]
 390        if {$p ne {}} {
 391                return $p
 392        }
 393        if {$empty_tree eq {}} {
 394                set empty_tree [exec git mktree << {}]
 395        }
 396        return $empty_tree
 397}
 398
 399proc rescan {after {honor_trustmtime 1}} {
 400        global HEAD PARENT MERGE_HEAD commit_type
 401        global ui_index ui_workdir ui_status_value ui_comm
 402        global rescan_active file_states
 403        global repo_config
 404
 405        if {$rescan_active > 0 || ![lock_index read]} return
 406
 407        repository_state newType newHEAD newMERGE_HEAD
 408        if {[string match amend* $commit_type]
 409                && $newType eq {normal}
 410                && $newHEAD eq $HEAD} {
 411        } else {
 412                set HEAD $newHEAD
 413                set PARENT $newHEAD
 414                set MERGE_HEAD $newMERGE_HEAD
 415                set commit_type $newType
 416        }
 417
 418        array unset file_states
 419
 420        if {![$ui_comm edit modified]
 421                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 422                if {[load_message GITGUI_MSG]} {
 423                } elseif {[load_message MERGE_MSG]} {
 424                } elseif {[load_message SQUASH_MSG]} {
 425                }
 426                $ui_comm edit reset
 427                $ui_comm edit modified false
 428        }
 429
 430        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 431                rescan_stage2 {} $after
 432        } else {
 433                set rescan_active 1
 434                set ui_status_value {Refreshing file status...}
 435                set cmd [list git update-index]
 436                lappend cmd -q
 437                lappend cmd --unmerged
 438                lappend cmd --ignore-missing
 439                lappend cmd --refresh
 440                set fd_rf [open "| $cmd" r]
 441                fconfigure $fd_rf -blocking 0 -translation binary
 442                fileevent $fd_rf readable \
 443                        [list rescan_stage2 $fd_rf $after]
 444        }
 445}
 446
 447proc rescan_stage2 {fd after} {
 448        global ui_status_value
 449        global rescan_active buf_rdi buf_rdf buf_rlo
 450
 451        if {$fd ne {}} {
 452                read $fd
 453                if {![eof $fd]} return
 454                close $fd
 455        }
 456
 457        set ls_others [list | git ls-files --others -z \
 458                --exclude-per-directory=.gitignore]
 459        set info_exclude [gitdir info exclude]
 460        if {[file readable $info_exclude]} {
 461                lappend ls_others "--exclude-from=$info_exclude"
 462        }
 463
 464        set buf_rdi {}
 465        set buf_rdf {}
 466        set buf_rlo {}
 467
 468        set rescan_active 3
 469        set ui_status_value {Scanning for modified files ...}
 470        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 471        set fd_df [open "| git diff-files -z" r]
 472        set fd_lo [open $ls_others r]
 473
 474        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 475        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 476        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 477        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 478        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 479        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 480}
 481
 482proc load_message {file} {
 483        global ui_comm
 484
 485        set f [gitdir $file]
 486        if {[file isfile $f]} {
 487                if {[catch {set fd [open $f r]}]} {
 488                        return 0
 489                }
 490                set content [string trim [read $fd]]
 491                close $fd
 492                regsub -all -line {[ \r\t]+$} $content {} content
 493                $ui_comm delete 0.0 end
 494                $ui_comm insert end $content
 495                return 1
 496        }
 497        return 0
 498}
 499
 500proc read_diff_index {fd after} {
 501        global buf_rdi
 502
 503        append buf_rdi [read $fd]
 504        set c 0
 505        set n [string length $buf_rdi]
 506        while {$c < $n} {
 507                set z1 [string first "\0" $buf_rdi $c]
 508                if {$z1 == -1} break
 509                incr z1
 510                set z2 [string first "\0" $buf_rdi $z1]
 511                if {$z2 == -1} break
 512
 513                incr c
 514                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 515                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 516                merge_state \
 517                        [encoding convertfrom $p] \
 518                        [lindex $i 4]? \
 519                        [list [lindex $i 0] [lindex $i 2]] \
 520                        [list]
 521                set c $z2
 522                incr c
 523        }
 524        if {$c < $n} {
 525                set buf_rdi [string range $buf_rdi $c end]
 526        } else {
 527                set buf_rdi {}
 528        }
 529
 530        rescan_done $fd buf_rdi $after
 531}
 532
 533proc read_diff_files {fd after} {
 534        global buf_rdf
 535
 536        append buf_rdf [read $fd]
 537        set c 0
 538        set n [string length $buf_rdf]
 539        while {$c < $n} {
 540                set z1 [string first "\0" $buf_rdf $c]
 541                if {$z1 == -1} break
 542                incr z1
 543                set z2 [string first "\0" $buf_rdf $z1]
 544                if {$z2 == -1} break
 545
 546                incr c
 547                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 548                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 549                merge_state \
 550                        [encoding convertfrom $p] \
 551                        ?[lindex $i 4] \
 552                        [list] \
 553                        [list [lindex $i 0] [lindex $i 2]]
 554                set c $z2
 555                incr c
 556        }
 557        if {$c < $n} {
 558                set buf_rdf [string range $buf_rdf $c end]
 559        } else {
 560                set buf_rdf {}
 561        }
 562
 563        rescan_done $fd buf_rdf $after
 564}
 565
 566proc read_ls_others {fd after} {
 567        global buf_rlo
 568
 569        append buf_rlo [read $fd]
 570        set pck [split $buf_rlo "\0"]
 571        set buf_rlo [lindex $pck end]
 572        foreach p [lrange $pck 0 end-1] {
 573                merge_state [encoding convertfrom $p] ?O
 574        }
 575        rescan_done $fd buf_rlo $after
 576}
 577
 578proc rescan_done {fd buf after} {
 579        global rescan_active
 580        global file_states repo_config
 581        upvar $buf to_clear
 582
 583        if {![eof $fd]} return
 584        set to_clear {}
 585        close $fd
 586        if {[incr rescan_active -1] > 0} return
 587
 588        prune_selection
 589        unlock_index
 590        display_all_files
 591        reshow_diff
 592        uplevel #0 $after
 593}
 594
 595proc prune_selection {} {
 596        global file_states selected_paths
 597
 598        foreach path [array names selected_paths] {
 599                if {[catch {set still_here $file_states($path)}]} {
 600                        unset selected_paths($path)
 601                }
 602        }
 603}
 604
 605######################################################################
 606##
 607## diff
 608
 609proc clear_diff {} {
 610        global ui_diff current_diff_path current_diff_header
 611        global ui_index ui_workdir
 612
 613        $ui_diff conf -state normal
 614        $ui_diff delete 0.0 end
 615        $ui_diff conf -state disabled
 616
 617        set current_diff_path {}
 618        set current_diff_header {}
 619
 620        $ui_index tag remove in_diff 0.0 end
 621        $ui_workdir tag remove in_diff 0.0 end
 622}
 623
 624proc reshow_diff {} {
 625        global ui_status_value file_states file_lists
 626        global current_diff_path current_diff_side
 627
 628        set p $current_diff_path
 629        if {$p eq {}
 630                || $current_diff_side eq {}
 631                || [catch {set s $file_states($p)}]
 632                || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 633                clear_diff
 634        } else {
 635                show_diff $p $current_diff_side
 636        }
 637}
 638
 639proc handle_empty_diff {} {
 640        global current_diff_path file_states file_lists
 641
 642        set path $current_diff_path
 643        set s $file_states($path)
 644        if {[lindex $s 0] ne {_M}} return
 645
 646        info_popup "No differences detected.
 647
 648[short_path $path] has no changes.
 649
 650The modification date of this file was updated
 651by another application, but the content within
 652the file was not changed.
 653
 654A rescan will be automatically started to find
 655other files which may have the same state."
 656
 657        clear_diff
 658        display_file $path __
 659        rescan {set ui_status_value {Ready.}} 0
 660}
 661
 662proc show_diff {path w {lno {}}} {
 663        global file_states file_lists
 664        global is_3way_diff diff_active repo_config
 665        global ui_diff ui_status_value ui_index ui_workdir
 666        global current_diff_path current_diff_side current_diff_header
 667
 668        if {$diff_active || ![lock_index read]} return
 669
 670        clear_diff
 671        if {$lno == {}} {
 672                set lno [lsearch -sorted -exact $file_lists($w) $path]
 673                if {$lno >= 0} {
 674                        incr lno
 675                }
 676        }
 677        if {$lno >= 1} {
 678                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 679        }
 680
 681        set s $file_states($path)
 682        set m [lindex $s 0]
 683        set is_3way_diff 0
 684        set diff_active 1
 685        set current_diff_path $path
 686        set current_diff_side $w
 687        set current_diff_header {}
 688        set ui_status_value "Loading diff of [escape_path $path]..."
 689
 690        # - Git won't give us the diff, there's nothing to compare to!
 691        #
 692        if {$m eq {_O}} {
 693                set max_sz [expr {128 * 1024}]
 694                if {[catch {
 695                                set fd [open $path r]
 696                                set content [read $fd $max_sz]
 697                                close $fd
 698                                set sz [file size $path]
 699                        } err ]} {
 700                        set diff_active 0
 701                        unlock_index
 702                        set ui_status_value "Unable to display [escape_path $path]"
 703                        error_popup "Error loading file:\n\n$err"
 704                        return
 705                }
 706                $ui_diff conf -state normal
 707                if {![catch {set type [exec file $path]}]} {
 708                        set n [string length $path]
 709                        if {[string equal -length $n $path $type]} {
 710                                set type [string range $type $n end]
 711                                regsub {^:?\s*} $type {} type
 712                        }
 713                        $ui_diff insert end "* $type\n" d_@
 714                }
 715                if {[string first "\0" $content] != -1} {
 716                        $ui_diff insert end \
 717                                "* Binary file (not showing content)." \
 718                                d_@
 719                } else {
 720                        if {$sz > $max_sz} {
 721                                $ui_diff insert end \
 722"* Untracked file is $sz bytes.
 723* Showing only first $max_sz bytes.
 724" d_@
 725                        }
 726                        $ui_diff insert end $content
 727                        if {$sz > $max_sz} {
 728                                $ui_diff insert end "
 729* Untracked file clipped here by [appname].
 730* To see the entire file, use an external editor.
 731" d_@
 732                        }
 733                }
 734                $ui_diff conf -state disabled
 735                set diff_active 0
 736                unlock_index
 737                set ui_status_value {Ready.}
 738                return
 739        }
 740
 741        set cmd [list | git]
 742        if {$w eq $ui_index} {
 743                lappend cmd diff-index
 744                lappend cmd --cached
 745        } elseif {$w eq $ui_workdir} {
 746                if {[string index $m 0] eq {U}} {
 747                        lappend cmd diff
 748                } else {
 749                        lappend cmd diff-files
 750                }
 751        }
 752
 753        lappend cmd -p
 754        lappend cmd --no-color
 755        if {$repo_config(gui.diffcontext) > 0} {
 756                lappend cmd "-U$repo_config(gui.diffcontext)"
 757        }
 758        if {$w eq $ui_index} {
 759                lappend cmd [PARENT]
 760        }
 761        lappend cmd --
 762        lappend cmd $path
 763
 764        if {[catch {set fd [open $cmd r]} err]} {
 765                set diff_active 0
 766                unlock_index
 767                set ui_status_value "Unable to display [escape_path $path]"
 768                error_popup "Error loading diff:\n\n$err"
 769                return
 770        }
 771
 772        fconfigure $fd \
 773                -blocking 0 \
 774                -encoding binary \
 775                -translation binary
 776        fileevent $fd readable [list read_diff $fd]
 777}
 778
 779proc read_diff {fd} {
 780        global ui_diff ui_status_value diff_active
 781        global is_3way_diff current_diff_header
 782
 783        $ui_diff conf -state normal
 784        while {[gets $fd line] >= 0} {
 785                # -- Cleanup uninteresting diff header lines.
 786                #
 787                if {   [string match {diff --git *}      $line]
 788                        || [string match {diff --cc *}       $line]
 789                        || [string match {diff --combined *} $line]
 790                        || [string match {--- *}             $line]
 791                        || [string match {+++ *}             $line]} {
 792                        append current_diff_header $line "\n"
 793                        continue
 794                }
 795                if {[string match {index *} $line]} continue
 796                if {$line eq {deleted file mode 120000}} {
 797                        set line "deleted symlink"
 798                }
 799
 800                # -- Automatically detect if this is a 3 way diff.
 801                #
 802                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 803
 804                if {[string match {mode *} $line]
 805                        || [string match {new file *} $line]
 806                        || [string match {deleted file *} $line]
 807                        || [string match {Binary files * and * differ} $line]
 808                        || $line eq {\ No newline at end of file}
 809                        || [regexp {^\* Unmerged path } $line]} {
 810                        set tags {}
 811                } elseif {$is_3way_diff} {
 812                        set op [string range $line 0 1]
 813                        switch -- $op {
 814                        {  } {set tags {}}
 815                        {@@} {set tags d_@}
 816                        { +} {set tags d_s+}
 817                        { -} {set tags d_s-}
 818                        {+ } {set tags d_+s}
 819                        {- } {set tags d_-s}
 820                        {--} {set tags d_--}
 821                        {++} {
 822                                if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 823                                        set line [string replace $line 0 1 {  }]
 824                                        set tags d$op
 825                                } else {
 826                                        set tags d_++
 827                                }
 828                        }
 829                        default {
 830                                puts "error: Unhandled 3 way diff marker: {$op}"
 831                                set tags {}
 832                        }
 833                        }
 834                } else {
 835                        set op [string index $line 0]
 836                        switch -- $op {
 837                        { } {set tags {}}
 838                        {@} {set tags d_@}
 839                        {-} {set tags d_-}
 840                        {+} {
 841                                if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 842                                        set line [string replace $line 0 0 { }]
 843                                        set tags d$op
 844                                } else {
 845                                        set tags d_+
 846                                }
 847                        }
 848                        default {
 849                                puts "error: Unhandled 2 way diff marker: {$op}"
 850                                set tags {}
 851                        }
 852                        }
 853                }
 854                $ui_diff insert end $line $tags
 855                if {[string index $line end] eq "\r"} {
 856                        $ui_diff tag add d_cr {end - 2c}
 857                }
 858                $ui_diff insert end "\n" $tags
 859        }
 860        $ui_diff conf -state disabled
 861
 862        if {[eof $fd]} {
 863                close $fd
 864                set diff_active 0
 865                unlock_index
 866                set ui_status_value {Ready.}
 867
 868                if {[$ui_diff index end] eq {2.0}} {
 869                        handle_empty_diff
 870                }
 871        }
 872}
 873
 874proc apply_hunk {x y} {
 875        global current_diff_path current_diff_header current_diff_side
 876        global ui_diff ui_index file_states
 877
 878        if {$current_diff_path eq {} || $current_diff_header eq {}} return
 879        if {![lock_index apply_hunk]} return
 880
 881        set apply_cmd {git apply --cached --whitespace=nowarn}
 882        set mi [lindex $file_states($current_diff_path) 0]
 883        if {$current_diff_side eq $ui_index} {
 884                set mode unstage
 885                lappend apply_cmd --reverse
 886                if {[string index $mi 0] ne {M}} {
 887                        unlock_index
 888                        return
 889                }
 890        } else {
 891                set mode stage
 892                if {[string index $mi 1] ne {M}} {
 893                        unlock_index
 894                        return
 895                }
 896        }
 897
 898        set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 899        set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 900        if {$s_lno eq {}} {
 901                unlock_index
 902                return
 903        }
 904
 905        set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 906        if {$e_lno eq {}} {
 907                set e_lno end
 908        }
 909
 910        if {[catch {
 911                set p [open "| $apply_cmd" w]
 912                fconfigure $p -translation binary -encoding binary
 913                puts -nonewline $p $current_diff_header
 914                puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 915                close $p} err]} {
 916                error_popup "Failed to $mode selected hunk.\n\n$err"
 917                unlock_index
 918                return
 919        }
 920
 921        $ui_diff conf -state normal
 922        $ui_diff delete $s_lno $e_lno
 923        $ui_diff conf -state disabled
 924
 925        if {[$ui_diff get 1.0 end] eq "\n"} {
 926                set o _
 927        } else {
 928                set o ?
 929        }
 930
 931        if {$current_diff_side eq $ui_index} {
 932                set mi ${o}M
 933        } elseif {[string index $mi 0] eq {_}} {
 934                set mi M$o
 935        } else {
 936                set mi ?$o
 937        }
 938        unlock_index
 939        display_file $current_diff_path $mi
 940        if {$o eq {_}} {
 941                clear_diff
 942        }
 943}
 944
 945######################################################################
 946##
 947## commit
 948
 949proc load_last_commit {} {
 950        global HEAD PARENT MERGE_HEAD commit_type ui_comm
 951        global repo_config
 952
 953        if {[llength $PARENT] == 0} {
 954                error_popup {There is nothing to amend.
 955
 956You are about to create the initial commit.
 957There is no commit before this to amend.
 958}
 959                return
 960        }
 961
 962        repository_state curType curHEAD curMERGE_HEAD
 963        if {$curType eq {merge}} {
 964                error_popup {Cannot amend while merging.
 965
 966You are currently in the middle of a merge that
 967has not been fully completed.  You cannot amend
 968the prior commit unless you first abort the
 969current merge activity.
 970}
 971                return
 972        }
 973
 974        set msg {}
 975        set parents [list]
 976        if {[catch {
 977                        set fd [open "| git cat-file commit $curHEAD" r]
 978                        fconfigure $fd -encoding binary -translation lf
 979                        if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 980                                set enc utf-8
 981                        }
 982                        while {[gets $fd line] > 0} {
 983                                if {[string match {parent *} $line]} {
 984                                        lappend parents [string range $line 7 end]
 985                                } elseif {[string match {encoding *} $line]} {
 986                                        set enc [string tolower [string range $line 9 end]]
 987                                }
 988                        }
 989                        fconfigure $fd -encoding $enc
 990                        set msg [string trim [read $fd]]
 991                        close $fd
 992                } err]} {
 993                error_popup "Error loading commit data for amend:\n\n$err"
 994                return
 995        }
 996
 997        set HEAD $curHEAD
 998        set PARENT $parents
 999        set MERGE_HEAD [list]
1000        switch -- [llength $parents] {
1001        0       {set commit_type amend-initial}
1002        1       {set commit_type amend}
1003        default {set commit_type amend-merge}
1004        }
1005
1006        $ui_comm delete 0.0 end
1007        $ui_comm insert end $msg
1008        $ui_comm edit reset
1009        $ui_comm edit modified false
1010        rescan {set ui_status_value {Ready.}}
1011}
1012
1013proc create_new_commit {} {
1014        global commit_type ui_comm
1015
1016        set commit_type normal
1017        $ui_comm delete 0.0 end
1018        $ui_comm edit reset
1019        $ui_comm edit modified false
1020        rescan {set ui_status_value {Ready.}}
1021}
1022
1023set GIT_COMMITTER_IDENT {}
1024
1025proc committer_ident {} {
1026        global GIT_COMMITTER_IDENT
1027
1028        if {$GIT_COMMITTER_IDENT eq {}} {
1029                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1030                        error_popup "Unable to obtain your identity:\n\n$err"
1031                        return {}
1032                }
1033                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1034                        $me me GIT_COMMITTER_IDENT]} {
1035                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1036                        return {}
1037                }
1038        }
1039
1040        return $GIT_COMMITTER_IDENT
1041}
1042
1043proc commit_tree {} {
1044        global HEAD commit_type file_states ui_comm repo_config
1045        global ui_status_value pch_error
1046
1047        if {[committer_ident] eq {}} return
1048        if {![lock_index update]} return
1049
1050        # -- Our in memory state should match the repository.
1051        #
1052        repository_state curType curHEAD curMERGE_HEAD
1053        if {[string match amend* $commit_type]
1054                && $curType eq {normal}
1055                && $curHEAD eq $HEAD} {
1056        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1057                info_popup {Last scanned state does not match repository state.
1058
1059Another Git program has modified this repository
1060since the last scan.  A rescan must be performed
1061before another commit can be created.
1062
1063The rescan will be automatically started now.
1064}
1065                unlock_index
1066                rescan {set ui_status_value {Ready.}}
1067                return
1068        }
1069
1070        # -- At least one file should differ in the index.
1071        #
1072        set files_ready 0
1073        foreach path [array names file_states] {
1074                switch -glob -- [lindex $file_states($path) 0] {
1075                _? {continue}
1076                A? -
1077                D? -
1078                M? {set files_ready 1}
1079                U? {
1080                        error_popup "Unmerged files cannot be committed.
1081
1082File [short_path $path] has merge conflicts.
1083You must resolve them and add the file before committing.
1084"
1085                        unlock_index
1086                        return
1087                }
1088                default {
1089                        error_popup "Unknown file state [lindex $s 0] detected.
1090
1091File [short_path $path] cannot be committed by this program.
1092"
1093                }
1094                }
1095        }
1096        if {!$files_ready} {
1097                info_popup {No changes to commit.
1098
1099You must add at least 1 file before you can commit.
1100}
1101                unlock_index
1102                return
1103        }
1104
1105        # -- A message is required.
1106        #
1107        set msg [string trim [$ui_comm get 1.0 end]]
1108        regsub -all -line {[ \t\r]+$} $msg {} msg
1109        if {$msg eq {}} {
1110                error_popup {Please supply a commit message.
1111
1112A good commit message has the following format:
1113
1114- First line: Describe in one sentance what you did.
1115- Second line: Blank
1116- Remaining lines: Describe why this change is good.
1117}
1118                unlock_index
1119                return
1120        }
1121
1122        # -- Run the pre-commit hook.
1123        #
1124        set pchook [gitdir hooks pre-commit]
1125
1126        # On Cygwin [file executable] might lie so we need to ask
1127        # the shell if the hook is executable.  Yes that's annoying.
1128        #
1129        if {[is_Cygwin] && [file isfile $pchook]} {
1130                set pchook [list sh -c [concat \
1131                        "if test -x \"$pchook\";" \
1132                        "then exec \"$pchook\" 2>&1;" \
1133                        "fi"]]
1134        } elseif {[file executable $pchook]} {
1135                set pchook [list $pchook |& cat]
1136        } else {
1137                commit_writetree $curHEAD $msg
1138                return
1139        }
1140
1141        set ui_status_value {Calling pre-commit hook...}
1142        set pch_error {}
1143        set fd_ph [open "| $pchook" r]
1144        fconfigure $fd_ph -blocking 0 -translation binary
1145        fileevent $fd_ph readable \
1146                [list commit_prehook_wait $fd_ph $curHEAD $msg]
1147}
1148
1149proc commit_prehook_wait {fd_ph curHEAD msg} {
1150        global pch_error ui_status_value
1151
1152        append pch_error [read $fd_ph]
1153        fconfigure $fd_ph -blocking 1
1154        if {[eof $fd_ph]} {
1155                if {[catch {close $fd_ph}]} {
1156                        set ui_status_value {Commit declined by pre-commit hook.}
1157                        hook_failed_popup pre-commit $pch_error
1158                        unlock_index
1159                } else {
1160                        commit_writetree $curHEAD $msg
1161                }
1162                set pch_error {}
1163                return
1164        }
1165        fconfigure $fd_ph -blocking 0
1166}
1167
1168proc commit_writetree {curHEAD msg} {
1169        global ui_status_value
1170
1171        set ui_status_value {Committing changes...}
1172        set fd_wt [open "| git write-tree" r]
1173        fileevent $fd_wt readable \
1174                [list commit_committree $fd_wt $curHEAD $msg]
1175}
1176
1177proc commit_committree {fd_wt curHEAD msg} {
1178        global HEAD PARENT MERGE_HEAD commit_type
1179        global single_commit all_heads current_branch
1180        global ui_status_value ui_comm selected_commit_type
1181        global file_states selected_paths rescan_active
1182        global repo_config
1183
1184        gets $fd_wt tree_id
1185        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1186                error_popup "write-tree failed:\n\n$err"
1187                set ui_status_value {Commit failed.}
1188                unlock_index
1189                return
1190        }
1191
1192        # -- Build the message.
1193        #
1194        set msg_p [gitdir COMMIT_EDITMSG]
1195        set msg_wt [open $msg_p w]
1196        if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1197                set enc utf-8
1198        }
1199        fconfigure $msg_wt -encoding $enc -translation binary
1200        puts -nonewline $msg_wt $msg
1201        close $msg_wt
1202
1203        # -- Create the commit.
1204        #
1205        set cmd [list git commit-tree $tree_id]
1206        set parents [concat $PARENT $MERGE_HEAD]
1207        if {[llength $parents] > 0} {
1208                foreach p $parents {
1209                        lappend cmd -p $p
1210                }
1211        } else {
1212                # git commit-tree writes to stderr during initial commit.
1213                lappend cmd 2>/dev/null
1214        }
1215        lappend cmd <$msg_p
1216        if {[catch {set cmt_id [eval exec $cmd]} err]} {
1217                error_popup "commit-tree failed:\n\n$err"
1218                set ui_status_value {Commit failed.}
1219                unlock_index
1220                return
1221        }
1222
1223        # -- Update the HEAD ref.
1224        #
1225        set reflogm commit
1226        if {$commit_type ne {normal}} {
1227                append reflogm " ($commit_type)"
1228        }
1229        set i [string first "\n" $msg]
1230        if {$i >= 0} {
1231                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1232        } else {
1233                append reflogm {: } $msg
1234        }
1235        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1236        if {[catch {eval exec $cmd} err]} {
1237                error_popup "update-ref failed:\n\n$err"
1238                set ui_status_value {Commit failed.}
1239                unlock_index
1240                return
1241        }
1242
1243        # -- Make sure our current branch exists.
1244        #
1245        if {$commit_type eq {initial}} {
1246                lappend all_heads $current_branch
1247                set all_heads [lsort -unique $all_heads]
1248                populate_branch_menu
1249        }
1250
1251        # -- Cleanup after ourselves.
1252        #
1253        catch {file delete $msg_p}
1254        catch {file delete [gitdir MERGE_HEAD]}
1255        catch {file delete [gitdir MERGE_MSG]}
1256        catch {file delete [gitdir SQUASH_MSG]}
1257        catch {file delete [gitdir GITGUI_MSG]}
1258
1259        # -- Let rerere do its thing.
1260        #
1261        if {[file isdirectory [gitdir rr-cache]]} {
1262                catch {exec git rerere}
1263        }
1264
1265        # -- Run the post-commit hook.
1266        #
1267        set pchook [gitdir hooks post-commit]
1268        if {[is_Cygwin] && [file isfile $pchook]} {
1269                set pchook [list sh -c [concat \
1270                        "if test -x \"$pchook\";" \
1271                        "then exec \"$pchook\";" \
1272                        "fi"]]
1273        } elseif {![file executable $pchook]} {
1274                set pchook {}
1275        }
1276        if {$pchook ne {}} {
1277                catch {exec $pchook &}
1278        }
1279
1280        $ui_comm delete 0.0 end
1281        $ui_comm edit reset
1282        $ui_comm edit modified false
1283
1284        if {$single_commit} do_quit
1285
1286        # -- Update in memory status
1287        #
1288        set selected_commit_type new
1289        set commit_type normal
1290        set HEAD $cmt_id
1291        set PARENT $cmt_id
1292        set MERGE_HEAD [list]
1293
1294        foreach path [array names file_states] {
1295                set s $file_states($path)
1296                set m [lindex $s 0]
1297                switch -glob -- $m {
1298                _O -
1299                _M -
1300                _D {continue}
1301                __ -
1302                A_ -
1303                M_ -
1304                D_ {
1305                        unset file_states($path)
1306                        catch {unset selected_paths($path)}
1307                }
1308                DO {
1309                        set file_states($path) [list _O [lindex $s 1] {} {}]
1310                }
1311                AM -
1312                AD -
1313                MM -
1314                MD {
1315                        set file_states($path) [list \
1316                                _[string index $m 1] \
1317                                [lindex $s 1] \
1318                                [lindex $s 3] \
1319                                {}]
1320                }
1321                }
1322        }
1323
1324        display_all_files
1325        unlock_index
1326        reshow_diff
1327        set ui_status_value \
1328                "Changes committed as [string range $cmt_id 0 7]."
1329}
1330
1331######################################################################
1332##
1333## fetch push
1334
1335proc fetch_from {remote} {
1336        set w [new_console \
1337                "fetch $remote" \
1338                "Fetching new changes from $remote"]
1339        set cmd [list git fetch]
1340        lappend cmd $remote
1341        console_exec $w $cmd console_done
1342}
1343
1344proc push_to {remote} {
1345        set w [new_console \
1346                "push $remote" \
1347                "Pushing changes to $remote"]
1348        set cmd [list git push]
1349        lappend cmd -v
1350        lappend cmd $remote
1351        console_exec $w $cmd console_done
1352}
1353
1354######################################################################
1355##
1356## ui helpers
1357
1358proc mapicon {w state path} {
1359        global all_icons
1360
1361        if {[catch {set r $all_icons($state$w)}]} {
1362                puts "error: no icon for $w state={$state} $path"
1363                return file_plain
1364        }
1365        return $r
1366}
1367
1368proc mapdesc {state path} {
1369        global all_descs
1370
1371        if {[catch {set r $all_descs($state)}]} {
1372                puts "error: no desc for state={$state} $path"
1373                return $state
1374        }
1375        return $r
1376}
1377
1378proc escape_path {path} {
1379        regsub -all "\n" $path "\\n" path
1380        return $path
1381}
1382
1383proc short_path {path} {
1384        return [escape_path [lindex [file split $path] end]]
1385}
1386
1387set next_icon_id 0
1388set null_sha1 [string repeat 0 40]
1389
1390proc merge_state {path new_state {head_info {}} {index_info {}}} {
1391        global file_states next_icon_id null_sha1
1392
1393        set s0 [string index $new_state 0]
1394        set s1 [string index $new_state 1]
1395
1396        if {[catch {set info $file_states($path)}]} {
1397                set state __
1398                set icon n[incr next_icon_id]
1399        } else {
1400                set state [lindex $info 0]
1401                set icon [lindex $info 1]
1402                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1403                if {$index_info eq {}} {set index_info [lindex $info 3]}
1404        }
1405
1406        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1407        elseif {$s0 eq {_}} {set s0 _}
1408
1409        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1410        elseif {$s1 eq {_}} {set s1 _}
1411
1412        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1413                set head_info [list 0 $null_sha1]
1414        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1415                && $head_info eq {}} {
1416                set head_info $index_info
1417        }
1418
1419        set file_states($path) [list $s0$s1 $icon \
1420                $head_info $index_info \
1421                ]
1422        return $state
1423}
1424
1425proc display_file_helper {w path icon_name old_m new_m} {
1426        global file_lists
1427
1428        if {$new_m eq {_}} {
1429                set lno [lsearch -sorted -exact $file_lists($w) $path]
1430                if {$lno >= 0} {
1431                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1432                        incr lno
1433                        $w conf -state normal
1434                        $w delete $lno.0 [expr {$lno + 1}].0
1435                        $w conf -state disabled
1436                }
1437        } elseif {$old_m eq {_} && $new_m ne {_}} {
1438                lappend file_lists($w) $path
1439                set file_lists($w) [lsort -unique $file_lists($w)]
1440                set lno [lsearch -sorted -exact $file_lists($w) $path]
1441                incr lno
1442                $w conf -state normal
1443                $w image create $lno.0 \
1444                        -align center -padx 5 -pady 1 \
1445                        -name $icon_name \
1446                        -image [mapicon $w $new_m $path]
1447                $w insert $lno.1 "[escape_path $path]\n"
1448                $w conf -state disabled
1449        } elseif {$old_m ne $new_m} {
1450                $w conf -state normal
1451                $w image conf $icon_name -image [mapicon $w $new_m $path]
1452                $w conf -state disabled
1453        }
1454}
1455
1456proc display_file {path state} {
1457        global file_states selected_paths
1458        global ui_index ui_workdir
1459
1460        set old_m [merge_state $path $state]
1461        set s $file_states($path)
1462        set new_m [lindex $s 0]
1463        set icon_name [lindex $s 1]
1464
1465        set o [string index $old_m 0]
1466        set n [string index $new_m 0]
1467        if {$o eq {U}} {
1468                set o _
1469        }
1470        if {$n eq {U}} {
1471                set n _
1472        }
1473        display_file_helper     $ui_index $path $icon_name $o $n
1474
1475        if {[string index $old_m 0] eq {U}} {
1476                set o U
1477        } else {
1478                set o [string index $old_m 1]
1479        }
1480        if {[string index $new_m 0] eq {U}} {
1481                set n U
1482        } else {
1483                set n [string index $new_m 1]
1484        }
1485        display_file_helper     $ui_workdir $path $icon_name $o $n
1486
1487        if {$new_m eq {__}} {
1488                unset file_states($path)
1489                catch {unset selected_paths($path)}
1490        }
1491}
1492
1493proc display_all_files_helper {w path icon_name m} {
1494        global file_lists
1495
1496        lappend file_lists($w) $path
1497        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1498        $w image create end \
1499                -align center -padx 5 -pady 1 \
1500                -name $icon_name \
1501                -image [mapicon $w $m $path]
1502        $w insert end "[escape_path $path]\n"
1503}
1504
1505proc display_all_files {} {
1506        global ui_index ui_workdir
1507        global file_states file_lists
1508        global last_clicked
1509
1510        $ui_index conf -state normal
1511        $ui_workdir conf -state normal
1512
1513        $ui_index delete 0.0 end
1514        $ui_workdir delete 0.0 end
1515        set last_clicked {}
1516
1517        set file_lists($ui_index) [list]
1518        set file_lists($ui_workdir) [list]
1519
1520        foreach path [lsort [array names file_states]] {
1521                set s $file_states($path)
1522                set m [lindex $s 0]
1523                set icon_name [lindex $s 1]
1524
1525                set s [string index $m 0]
1526                if {$s ne {U} && $s ne {_}} {
1527                        display_all_files_helper $ui_index $path \
1528                                $icon_name $s
1529                }
1530
1531                if {[string index $m 0] eq {U}} {
1532                        set s U
1533                } else {
1534                        set s [string index $m 1]
1535                }
1536                if {$s ne {_}} {
1537                        display_all_files_helper $ui_workdir $path \
1538                                $icon_name $s
1539                }
1540        }
1541
1542        $ui_index conf -state disabled
1543        $ui_workdir conf -state disabled
1544}
1545
1546proc update_indexinfo {msg pathList after} {
1547        global update_index_cp ui_status_value
1548
1549        if {![lock_index update]} return
1550
1551        set update_index_cp 0
1552        set pathList [lsort $pathList]
1553        set totalCnt [llength $pathList]
1554        set batch [expr {int($totalCnt * .01) + 1}]
1555        if {$batch > 25} {set batch 25}
1556
1557        set ui_status_value [format \
1558                "$msg... %i/%i files (%.2f%%)" \
1559                $update_index_cp \
1560                $totalCnt \
1561                0.0]
1562        set fd [open "| git update-index -z --index-info" w]
1563        fconfigure $fd \
1564                -blocking 0 \
1565                -buffering full \
1566                -buffersize 512 \
1567                -encoding binary \
1568                -translation binary
1569        fileevent $fd writable [list \
1570                write_update_indexinfo \
1571                $fd \
1572                $pathList \
1573                $totalCnt \
1574                $batch \
1575                $msg \
1576                $after \
1577                ]
1578}
1579
1580proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1581        global update_index_cp ui_status_value
1582        global file_states current_diff_path
1583
1584        if {$update_index_cp >= $totalCnt} {
1585                close $fd
1586                unlock_index
1587                uplevel #0 $after
1588                return
1589        }
1590
1591        for {set i $batch} \
1592                {$update_index_cp < $totalCnt && $i > 0} \
1593                {incr i -1} {
1594                set path [lindex $pathList $update_index_cp]
1595                incr update_index_cp
1596
1597                set s $file_states($path)
1598                switch -glob -- [lindex $s 0] {
1599                A? {set new _O}
1600                M? {set new _M}
1601                D_ {set new _D}
1602                D? {set new _?}
1603                ?? {continue}
1604                }
1605                set info [lindex $s 2]
1606                if {$info eq {}} continue
1607
1608                puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1609                display_file $path $new
1610        }
1611
1612        set ui_status_value [format \
1613                "$msg... %i/%i files (%.2f%%)" \
1614                $update_index_cp \
1615                $totalCnt \
1616                [expr {100.0 * $update_index_cp / $totalCnt}]]
1617}
1618
1619proc update_index {msg pathList after} {
1620        global update_index_cp ui_status_value
1621
1622        if {![lock_index update]} return
1623
1624        set update_index_cp 0
1625        set pathList [lsort $pathList]
1626        set totalCnt [llength $pathList]
1627        set batch [expr {int($totalCnt * .01) + 1}]
1628        if {$batch > 25} {set batch 25}
1629
1630        set ui_status_value [format \
1631                "$msg... %i/%i files (%.2f%%)" \
1632                $update_index_cp \
1633                $totalCnt \
1634                0.0]
1635        set fd [open "| git update-index --add --remove -z --stdin" w]
1636        fconfigure $fd \
1637                -blocking 0 \
1638                -buffering full \
1639                -buffersize 512 \
1640                -encoding binary \
1641                -translation binary
1642        fileevent $fd writable [list \
1643                write_update_index \
1644                $fd \
1645                $pathList \
1646                $totalCnt \
1647                $batch \
1648                $msg \
1649                $after \
1650                ]
1651}
1652
1653proc write_update_index {fd pathList totalCnt batch msg after} {
1654        global update_index_cp ui_status_value
1655        global file_states current_diff_path
1656
1657        if {$update_index_cp >= $totalCnt} {
1658                close $fd
1659                unlock_index
1660                uplevel #0 $after
1661                return
1662        }
1663
1664        for {set i $batch} \
1665                {$update_index_cp < $totalCnt && $i > 0} \
1666                {incr i -1} {
1667                set path [lindex $pathList $update_index_cp]
1668                incr update_index_cp
1669
1670                switch -glob -- [lindex $file_states($path) 0] {
1671                AD {set new __}
1672                ?D {set new D_}
1673                _O -
1674                AM {set new A_}
1675                U? {
1676                        if {[file exists $path]} {
1677                                set new M_
1678                        } else {
1679                                set new D_
1680                        }
1681                }
1682                ?M {set new M_}
1683                ?? {continue}
1684                }
1685                puts -nonewline $fd "[encoding convertto $path]\0"
1686                display_file $path $new
1687        }
1688
1689        set ui_status_value [format \
1690                "$msg... %i/%i files (%.2f%%)" \
1691                $update_index_cp \
1692                $totalCnt \
1693                [expr {100.0 * $update_index_cp / $totalCnt}]]
1694}
1695
1696proc checkout_index {msg pathList after} {
1697        global update_index_cp ui_status_value
1698
1699        if {![lock_index update]} return
1700
1701        set update_index_cp 0
1702        set pathList [lsort $pathList]
1703        set totalCnt [llength $pathList]
1704        set batch [expr {int($totalCnt * .01) + 1}]
1705        if {$batch > 25} {set batch 25}
1706
1707        set ui_status_value [format \
1708                "$msg... %i/%i files (%.2f%%)" \
1709                $update_index_cp \
1710                $totalCnt \
1711                0.0]
1712        set cmd [list git checkout-index]
1713        lappend cmd --index
1714        lappend cmd --quiet
1715        lappend cmd --force
1716        lappend cmd -z
1717        lappend cmd --stdin
1718        set fd [open "| $cmd " w]
1719        fconfigure $fd \
1720                -blocking 0 \
1721                -buffering full \
1722                -buffersize 512 \
1723                -encoding binary \
1724                -translation binary
1725        fileevent $fd writable [list \
1726                write_checkout_index \
1727                $fd \
1728                $pathList \
1729                $totalCnt \
1730                $batch \
1731                $msg \
1732                $after \
1733                ]
1734}
1735
1736proc write_checkout_index {fd pathList totalCnt batch msg after} {
1737        global update_index_cp ui_status_value
1738        global file_states current_diff_path
1739
1740        if {$update_index_cp >= $totalCnt} {
1741                close $fd
1742                unlock_index
1743                uplevel #0 $after
1744                return
1745        }
1746
1747        for {set i $batch} \
1748                {$update_index_cp < $totalCnt && $i > 0} \
1749                {incr i -1} {
1750                set path [lindex $pathList $update_index_cp]
1751                incr update_index_cp
1752                switch -glob -- [lindex $file_states($path) 0] {
1753                U? {continue}
1754                ?M -
1755                ?D {
1756                        puts -nonewline $fd "[encoding convertto $path]\0"
1757                        display_file $path ?_
1758                }
1759                }
1760        }
1761
1762        set ui_status_value [format \
1763                "$msg... %i/%i files (%.2f%%)" \
1764                $update_index_cp \
1765                $totalCnt \
1766                [expr {100.0 * $update_index_cp / $totalCnt}]]
1767}
1768
1769######################################################################
1770##
1771## branch management
1772
1773proc is_tracking_branch {name} {
1774        global tracking_branches
1775
1776        if {![catch {set info $tracking_branches($name)}]} {
1777                return 1
1778        }
1779        foreach t [array names tracking_branches] {
1780                if {[string match {*/\*} $t] && [string match $t $name]} {
1781                        return 1
1782                }
1783        }
1784        return 0
1785}
1786
1787proc load_all_heads {} {
1788        global all_heads
1789
1790        set all_heads [list]
1791        set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1792        while {[gets $fd line] > 0} {
1793                if {[is_tracking_branch $line]} continue
1794                if {![regsub ^refs/heads/ $line {} name]} continue
1795                lappend all_heads $name
1796        }
1797        close $fd
1798
1799        set all_heads [lsort $all_heads]
1800}
1801
1802proc populate_branch_menu {} {
1803        global all_heads disable_on_lock
1804
1805        set m .mbar.branch
1806        set last [$m index last]
1807        for {set i 0} {$i <= $last} {incr i} {
1808                if {[$m type $i] eq {separator}} {
1809                        $m delete $i last
1810                        set new_dol [list]
1811                        foreach a $disable_on_lock {
1812                                if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1813                                        lappend new_dol $a
1814                                }
1815                        }
1816                        set disable_on_lock $new_dol
1817                        break
1818                }
1819        }
1820
1821        if {$all_heads ne {}} {
1822                $m add separator
1823        }
1824        foreach b $all_heads {
1825                $m add radiobutton \
1826                        -label $b \
1827                        -command [list switch_branch $b] \
1828                        -variable current_branch \
1829                        -value $b \
1830                        -font font_ui
1831                lappend disable_on_lock \
1832                        [list $m entryconf [$m index last] -state]
1833        }
1834}
1835
1836proc all_tracking_branches {} {
1837        global tracking_branches
1838
1839        set all_trackings {}
1840        set cmd {}
1841        foreach name [array names tracking_branches] {
1842                if {[regsub {/\*$} $name {} name]} {
1843                        lappend cmd $name
1844                } else {
1845                        regsub ^refs/(heads|remotes)/ $name {} name
1846                        lappend all_trackings $name
1847                }
1848        }
1849
1850        if {$cmd ne {}} {
1851                set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1852                while {[gets $fd name] > 0} {
1853                        regsub ^refs/(heads|remotes)/ $name {} name
1854                        lappend all_trackings $name
1855                }
1856                close $fd
1857        }
1858
1859        return [lsort -unique $all_trackings]
1860}
1861
1862proc do_create_branch_action {w} {
1863        global all_heads null_sha1 repo_config
1864        global create_branch_checkout create_branch_revtype
1865        global create_branch_head create_branch_trackinghead
1866        global create_branch_name create_branch_revexp
1867
1868        set newbranch $create_branch_name
1869        if {$newbranch eq {}
1870                || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1871                tk_messageBox \
1872                        -icon error \
1873                        -type ok \
1874                        -title [wm title $w] \
1875                        -parent $w \
1876                        -message "Please supply a branch name."
1877                focus $w.desc.name_t
1878                return
1879        }
1880        if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1881                tk_messageBox \
1882                        -icon error \
1883                        -type ok \
1884                        -title [wm title $w] \
1885                        -parent $w \
1886                        -message "Branch '$newbranch' already exists."
1887                focus $w.desc.name_t
1888                return
1889        }
1890        if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1891                tk_messageBox \
1892                        -icon error \
1893                        -type ok \
1894                        -title [wm title $w] \
1895                        -parent $w \
1896                        -message "We do not like '$newbranch' as a branch name."
1897                focus $w.desc.name_t
1898                return
1899        }
1900
1901        set rev {}
1902        switch -- $create_branch_revtype {
1903        head {set rev $create_branch_head}
1904        tracking {set rev $create_branch_trackinghead}
1905        expression {set rev $create_branch_revexp}
1906        }
1907        if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1908                tk_messageBox \
1909                        -icon error \
1910                        -type ok \
1911                        -title [wm title $w] \
1912                        -parent $w \
1913                        -message "Invalid starting revision: $rev"
1914                return
1915        }
1916        set cmd [list git update-ref]
1917        lappend cmd -m
1918        lappend cmd "branch: Created from $rev"
1919        lappend cmd "refs/heads/$newbranch"
1920        lappend cmd $cmt
1921        lappend cmd $null_sha1
1922        if {[catch {eval exec $cmd} err]} {
1923                tk_messageBox \
1924                        -icon error \
1925                        -type ok \
1926                        -title [wm title $w] \
1927                        -parent $w \
1928                        -message "Failed to create '$newbranch'.\n\n$err"
1929                return
1930        }
1931
1932        lappend all_heads $newbranch
1933        set all_heads [lsort $all_heads]
1934        populate_branch_menu
1935        destroy $w
1936        if {$create_branch_checkout} {
1937                switch_branch $newbranch
1938        }
1939}
1940
1941proc radio_selector {varname value args} {
1942        upvar #0 $varname var
1943        set var $value
1944}
1945
1946trace add variable create_branch_head write \
1947        [list radio_selector create_branch_revtype head]
1948trace add variable create_branch_trackinghead write \
1949        [list radio_selector create_branch_revtype tracking]
1950
1951trace add variable delete_branch_head write \
1952        [list radio_selector delete_branch_checktype head]
1953trace add variable delete_branch_trackinghead write \
1954        [list radio_selector delete_branch_checktype tracking]
1955
1956proc do_create_branch {} {
1957        global all_heads current_branch repo_config
1958        global create_branch_checkout create_branch_revtype
1959        global create_branch_head create_branch_trackinghead
1960        global create_branch_name create_branch_revexp
1961
1962        set w .branch_editor
1963        toplevel $w
1964        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1965
1966        label $w.header -text {Create New Branch} \
1967                -font font_uibold
1968        pack $w.header -side top -fill x
1969
1970        frame $w.buttons
1971        button $w.buttons.create -text Create \
1972                -font font_ui \
1973                -default active \
1974                -command [list do_create_branch_action $w]
1975        pack $w.buttons.create -side right
1976        button $w.buttons.cancel -text {Cancel} \
1977                -font font_ui \
1978                -command [list destroy $w]
1979        pack $w.buttons.cancel -side right -padx 5
1980        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1981
1982        labelframe $w.desc \
1983                -text {Branch Description} \
1984                -font font_ui
1985        label $w.desc.name_l -text {Name:} -font font_ui
1986        entry $w.desc.name_t \
1987                -borderwidth 1 \
1988                -relief sunken \
1989                -width 40 \
1990                -textvariable create_branch_name \
1991                -font font_ui \
1992                -validate key \
1993                -validatecommand {
1994                        if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
1995                        return 1
1996                }
1997        grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1998        grid columnconfigure $w.desc 1 -weight 1
1999        pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2000
2001        labelframe $w.from \
2002                -text {Starting Revision} \
2003                -font font_ui
2004        radiobutton $w.from.head_r \
2005                -text {Local Branch:} \
2006                -value head \
2007                -variable create_branch_revtype \
2008                -font font_ui
2009        eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2010        grid $w.from.head_r $w.from.head_m -sticky w
2011        set all_trackings [all_tracking_branches]
2012        if {$all_trackings ne {}} {
2013                set create_branch_trackinghead [lindex $all_trackings 0]
2014                radiobutton $w.from.tracking_r \
2015                        -text {Tracking Branch:} \
2016                        -value tracking \
2017                        -variable create_branch_revtype \
2018                        -font font_ui
2019                eval tk_optionMenu $w.from.tracking_m \
2020                        create_branch_trackinghead \
2021                        $all_trackings
2022                grid $w.from.tracking_r $w.from.tracking_m -sticky w
2023        }
2024        radiobutton $w.from.exp_r \
2025                -text {Revision Expression:} \
2026                -value expression \
2027                -variable create_branch_revtype \
2028                -font font_ui
2029        entry $w.from.exp_t \
2030                -borderwidth 1 \
2031                -relief sunken \
2032                -width 50 \
2033                -textvariable create_branch_revexp \
2034                -font font_ui \
2035                -validate key \
2036                -validatecommand {
2037                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2038                        if {%d == 1 && [string length %S] > 0} {
2039                                set create_branch_revtype expression
2040                        }
2041                        return 1
2042                }
2043        grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2044        grid columnconfigure $w.from 1 -weight 1
2045        pack $w.from -anchor nw -fill x -pady 5 -padx 5
2046
2047        labelframe $w.postActions \
2048                -text {Post Creation Actions} \
2049                -font font_ui
2050        checkbutton $w.postActions.checkout \
2051                -text {Checkout after creation} \
2052                -variable create_branch_checkout \
2053                -font font_ui
2054        pack $w.postActions.checkout -anchor nw
2055        pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2056
2057        set create_branch_checkout 1
2058        set create_branch_head $current_branch
2059        set create_branch_revtype head
2060        set create_branch_name $repo_config(gui.newbranchtemplate)
2061        set create_branch_revexp {}
2062
2063        bind $w <Visibility> "
2064                grab $w
2065                $w.desc.name_t icursor end
2066                focus $w.desc.name_t
2067        "
2068        bind $w <Key-Escape> "destroy $w"
2069        bind $w <Key-Return> "do_create_branch_action $w;break"
2070        wm title $w "[appname] ([reponame]): Create Branch"
2071        tkwait window $w
2072}
2073
2074proc do_delete_branch_action {w} {
2075        global all_heads
2076        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2077
2078        set check_rev {}
2079        switch -- $delete_branch_checktype {
2080        head {set check_rev $delete_branch_head}
2081        tracking {set check_rev $delete_branch_trackinghead}
2082        always {set check_rev {:none}}
2083        }
2084        if {$check_rev eq {:none}} {
2085                set check_cmt {}
2086        } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2087                tk_messageBox \
2088                        -icon error \
2089                        -type ok \
2090                        -title [wm title $w] \
2091                        -parent $w \
2092                        -message "Invalid check revision: $check_rev"
2093                return
2094        }
2095
2096        set to_delete [list]
2097        set not_merged [list]
2098        foreach i [$w.list.l curselection] {
2099                set b [$w.list.l get $i]
2100                if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2101                if {$check_cmt ne {}} {
2102                        if {$b eq $check_rev} continue
2103                        if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2104                        if {$o ne $m} {
2105                                lappend not_merged $b
2106                                continue
2107                        }
2108                }
2109                lappend to_delete [list $b $o]
2110        }
2111        if {$not_merged ne {}} {
2112                set msg "The following branches are not completely merged into $check_rev:
2113
2114 - [join $not_merged "\n - "]"
2115                tk_messageBox \
2116                        -icon info \
2117                        -type ok \
2118                        -title [wm title $w] \
2119                        -parent $w \
2120                        -message $msg
2121        }
2122        if {$to_delete eq {}} return
2123        if {$delete_branch_checktype eq {always}} {
2124                set msg {Recovering deleted branches is difficult.
2125
2126Delete the selected branches?}
2127                if {[tk_messageBox \
2128                        -icon warning \
2129                        -type yesno \
2130                        -title [wm title $w] \
2131                        -parent $w \
2132                        -message $msg] ne yes} {
2133                        return
2134                }
2135        }
2136
2137        set failed {}
2138        foreach i $to_delete {
2139                set b [lindex $i 0]
2140                set o [lindex $i 1]
2141                if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2142                        append failed " - $b: $err\n"
2143                } else {
2144                        set x [lsearch -sorted -exact $all_heads $b]
2145                        if {$x >= 0} {
2146                                set all_heads [lreplace $all_heads $x $x]
2147                        }
2148                }
2149        }
2150
2151        if {$failed ne {}} {
2152                tk_messageBox \
2153                        -icon error \
2154                        -type ok \
2155                        -title [wm title $w] \
2156                        -parent $w \
2157                        -message "Failed to delete branches:\n$failed"
2158        }
2159
2160        set all_heads [lsort $all_heads]
2161        populate_branch_menu
2162        destroy $w
2163}
2164
2165proc do_delete_branch {} {
2166        global all_heads tracking_branches current_branch
2167        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2168
2169        set w .branch_editor
2170        toplevel $w
2171        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2172
2173        label $w.header -text {Delete Local Branch} \
2174                -font font_uibold
2175        pack $w.header -side top -fill x
2176
2177        frame $w.buttons
2178        button $w.buttons.create -text Delete \
2179                -font font_ui \
2180                -command [list do_delete_branch_action $w]
2181        pack $w.buttons.create -side right
2182        button $w.buttons.cancel -text {Cancel} \
2183                -font font_ui \
2184                -command [list destroy $w]
2185        pack $w.buttons.cancel -side right -padx 5
2186        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2187
2188        labelframe $w.list \
2189                -text {Local Branches} \
2190                -font font_ui
2191        listbox $w.list.l \
2192                -height 10 \
2193                -width 70 \
2194                -selectmode extended \
2195                -yscrollcommand [list $w.list.sby set] \
2196                -font font_ui
2197        foreach h $all_heads {
2198                if {$h ne $current_branch} {
2199                        $w.list.l insert end $h
2200                }
2201        }
2202        scrollbar $w.list.sby -command [list $w.list.l yview]
2203        pack $w.list.sby -side right -fill y
2204        pack $w.list.l -side left -fill both -expand 1
2205        pack $w.list -fill both -expand 1 -pady 5 -padx 5
2206
2207        labelframe $w.validate \
2208                -text {Delete Only If} \
2209                -font font_ui
2210        radiobutton $w.validate.head_r \
2211                -text {Merged Into Local Branch:} \
2212                -value head \
2213                -variable delete_branch_checktype \
2214                -font font_ui
2215        eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2216        grid $w.validate.head_r $w.validate.head_m -sticky w
2217        set all_trackings [all_tracking_branches]
2218        if {$all_trackings ne {}} {
2219                set delete_branch_trackinghead [lindex $all_trackings 0]
2220                radiobutton $w.validate.tracking_r \
2221                        -text {Merged Into Tracking Branch:} \
2222                        -value tracking \
2223                        -variable delete_branch_checktype \
2224                        -font font_ui
2225                eval tk_optionMenu $w.validate.tracking_m \
2226                        delete_branch_trackinghead \
2227                        $all_trackings
2228                grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2229        }
2230        radiobutton $w.validate.always_r \
2231                -text {Always (Do not perform merge checks)} \
2232                -value always \
2233                -variable delete_branch_checktype \
2234                -font font_ui
2235        grid $w.validate.always_r -columnspan 2 -sticky w
2236        grid columnconfigure $w.validate 1 -weight 1
2237        pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2238
2239        set delete_branch_head $current_branch
2240        set delete_branch_checktype head
2241
2242        bind $w <Visibility> "grab $w; focus $w"
2243        bind $w <Key-Escape> "destroy $w"
2244        wm title $w "[appname] ([reponame]): Delete Branch"
2245        tkwait window $w
2246}
2247
2248proc switch_branch {new_branch} {
2249        global HEAD commit_type current_branch repo_config
2250
2251        if {![lock_index switch]} return
2252
2253        # -- Our in memory state should match the repository.
2254        #
2255        repository_state curType curHEAD curMERGE_HEAD
2256        if {[string match amend* $commit_type]
2257                && $curType eq {normal}
2258                && $curHEAD eq $HEAD} {
2259        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2260                info_popup {Last scanned state does not match repository state.
2261
2262Another Git program has modified this repository
2263since the last scan.  A rescan must be performed
2264before the current branch can be changed.
2265
2266The rescan will be automatically started now.
2267}
2268                unlock_index
2269                rescan {set ui_status_value {Ready.}}
2270                return
2271        }
2272
2273        # -- Don't do a pointless switch.
2274        #
2275        if {$current_branch eq $new_branch} {
2276                unlock_index
2277                return
2278        }
2279
2280        if {$repo_config(gui.trustmtime) eq {true}} {
2281                switch_branch_stage2 {} $new_branch
2282        } else {
2283                set ui_status_value {Refreshing file status...}
2284                set cmd [list git update-index]
2285                lappend cmd -q
2286                lappend cmd --unmerged
2287                lappend cmd --ignore-missing
2288                lappend cmd --refresh
2289                set fd_rf [open "| $cmd" r]
2290                fconfigure $fd_rf -blocking 0 -translation binary
2291                fileevent $fd_rf readable \
2292                        [list switch_branch_stage2 $fd_rf $new_branch]
2293        }
2294}
2295
2296proc switch_branch_stage2 {fd_rf new_branch} {
2297        global ui_status_value HEAD
2298
2299        if {$fd_rf ne {}} {
2300                read $fd_rf
2301                if {![eof $fd_rf]} return
2302                close $fd_rf
2303        }
2304
2305        set ui_status_value "Updating working directory to '$new_branch'..."
2306        set cmd [list git read-tree]
2307        lappend cmd -m
2308        lappend cmd -u
2309        lappend cmd --exclude-per-directory=.gitignore
2310        lappend cmd $HEAD
2311        lappend cmd $new_branch
2312        set fd_rt [open "| $cmd" r]
2313        fconfigure $fd_rt -blocking 0 -translation binary
2314        fileevent $fd_rt readable \
2315                [list switch_branch_readtree_wait $fd_rt $new_branch]
2316}
2317
2318proc switch_branch_readtree_wait {fd_rt new_branch} {
2319        global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2320        global current_branch
2321        global ui_comm ui_status_value
2322
2323        # -- We never get interesting output on stdout; only stderr.
2324        #
2325        read $fd_rt
2326        fconfigure $fd_rt -blocking 1
2327        if {![eof $fd_rt]} {
2328                fconfigure $fd_rt -blocking 0
2329                return
2330        }
2331
2332        # -- The working directory wasn't in sync with the index and
2333        #    we'd have to overwrite something to make the switch. A
2334        #    merge is required.
2335        #
2336        if {[catch {close $fd_rt} err]} {
2337                regsub {^fatal: } $err {} err
2338                warn_popup "File level merge required.
2339
2340$err
2341
2342Staying on branch '$current_branch'."
2343                set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2344                unlock_index
2345                return
2346        }
2347
2348        # -- Update the symbolic ref.  Core git doesn't even check for failure
2349        #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2350        #    state that is difficult to recover from within git-gui.
2351        #
2352        if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2353                error_popup "Failed to set current branch.
2354
2355This working directory is only partially switched.
2356We successfully updated your files, but failed to
2357update an internal Git file.
2358
2359This should not have occurred.  [appname] will now
2360close and give up.
2361
2362$err"
2363                do_quit
2364                return
2365        }
2366
2367        # -- Update our repository state.  If we were previously in amend mode
2368        #    we need to toss the current buffer and do a full rescan to update
2369        #    our file lists.  If we weren't in amend mode our file lists are
2370        #    accurate and we can avoid the rescan.
2371        #
2372        unlock_index
2373        set selected_commit_type new
2374        if {[string match amend* $commit_type]} {
2375                $ui_comm delete 0.0 end
2376                $ui_comm edit reset
2377                $ui_comm edit modified false
2378                rescan {set ui_status_value "Checked out branch '$current_branch'."}
2379        } else {
2380                repository_state commit_type HEAD MERGE_HEAD
2381                set PARENT $HEAD
2382                set ui_status_value "Checked out branch '$current_branch'."
2383        }
2384}
2385
2386######################################################################
2387##
2388## remote management
2389
2390proc load_all_remotes {} {
2391        global repo_config
2392        global all_remotes tracking_branches
2393
2394        set all_remotes [list]
2395        array unset tracking_branches
2396
2397        set rm_dir [gitdir remotes]
2398        if {[file isdirectory $rm_dir]} {
2399                set all_remotes [glob \
2400                        -types f \
2401                        -tails \
2402                        -nocomplain \
2403                        -directory $rm_dir *]
2404
2405                foreach name $all_remotes {
2406                        catch {
2407                                set fd [open [file join $rm_dir $name] r]
2408                                while {[gets $fd line] >= 0} {
2409                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2410                                                $line line src dst]} continue
2411                                        if {![regexp ^refs/ $dst]} {
2412                                                set dst "refs/heads/$dst"
2413                                        }
2414                                        set tracking_branches($dst) [list $name $src]
2415                                }
2416                                close $fd
2417                        }
2418                }
2419        }
2420
2421        foreach line [array names repo_config remote.*.url] {
2422                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2423                lappend all_remotes $name
2424
2425                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2426                        set fl {}
2427                }
2428                foreach line $fl {
2429                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2430                        if {![regexp ^refs/ $dst]} {
2431                                set dst "refs/heads/$dst"
2432                        }
2433                        set tracking_branches($dst) [list $name $src]
2434                }
2435        }
2436
2437        set all_remotes [lsort -unique $all_remotes]
2438}
2439
2440proc populate_fetch_menu {} {
2441        global all_remotes repo_config
2442
2443        set m .mbar.fetch
2444        foreach r $all_remotes {
2445                set enable 0
2446                if {![catch {set a $repo_config(remote.$r.url)}]} {
2447                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2448                                set enable 1
2449                        }
2450                } else {
2451                        catch {
2452                                set fd [open [gitdir remotes $r] r]
2453                                while {[gets $fd n] >= 0} {
2454                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2455                                                set enable 1
2456                                                break
2457                                        }
2458                                }
2459                                close $fd
2460                        }
2461                }
2462
2463                if {$enable} {
2464                        $m add command \
2465                                -label "Fetch from $r..." \
2466                                -command [list fetch_from $r] \
2467                                -font font_ui
2468                }
2469        }
2470}
2471
2472proc populate_push_menu {} {
2473        global all_remotes repo_config
2474
2475        set m .mbar.push
2476        set fast_count 0
2477        foreach r $all_remotes {
2478                set enable 0
2479                if {![catch {set a $repo_config(remote.$r.url)}]} {
2480                        if {![catch {set a $repo_config(remote.$r.push)}]} {
2481                                set enable 1
2482                        }
2483                } else {
2484                        catch {
2485                                set fd [open [gitdir remotes $r] r]
2486                                while {[gets $fd n] >= 0} {
2487                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2488                                                set enable 1
2489                                                break
2490                                        }
2491                                }
2492                                close $fd
2493                        }
2494                }
2495
2496                if {$enable} {
2497                        if {!$fast_count} {
2498                                $m add separator
2499                        }
2500                        $m add command \
2501                                -label "Push to $r..." \
2502                                -command [list push_to $r] \
2503                                -font font_ui
2504                        incr fast_count
2505                }
2506        }
2507}
2508
2509proc start_push_anywhere_action {w} {
2510        global push_urltype push_remote push_url push_thin push_tags
2511
2512        set r_url {}
2513        switch -- $push_urltype {
2514        remote {set r_url $push_remote}
2515        url {set r_url $push_url}
2516        }
2517        if {$r_url eq {}} return
2518
2519        set cmd [list git push]
2520        lappend cmd -v
2521        if {$push_thin} {
2522                lappend cmd --thin
2523        }
2524        if {$push_tags} {
2525                lappend cmd --tags
2526        }
2527        lappend cmd $r_url
2528        set cnt 0
2529        foreach i [$w.source.l curselection] {
2530                set b [$w.source.l get $i]
2531                lappend cmd "refs/heads/$b:refs/heads/$b"
2532                incr cnt
2533        }
2534        if {$cnt == 0} {
2535                return
2536        } elseif {$cnt == 1} {
2537                set unit branch
2538        } else {
2539                set unit branches
2540        }
2541
2542        set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2543        console_exec $cons $cmd console_done
2544        destroy $w
2545}
2546
2547trace add variable push_remote write \
2548        [list radio_selector push_urltype remote]
2549
2550proc do_push_anywhere {} {
2551        global all_heads all_remotes current_branch
2552        global push_urltype push_remote push_url push_thin push_tags
2553
2554        set w .push_setup
2555        toplevel $w
2556        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2557
2558        label $w.header -text {Push Branches} -font font_uibold
2559        pack $w.header -side top -fill x
2560
2561        frame $w.buttons
2562        button $w.buttons.create -text Push \
2563                -font font_ui \
2564                -command [list start_push_anywhere_action $w]
2565        pack $w.buttons.create -side right
2566        button $w.buttons.cancel -text {Cancel} \
2567                -font font_ui \
2568                -command [list destroy $w]
2569        pack $w.buttons.cancel -side right -padx 5
2570        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2571
2572        labelframe $w.source \
2573                -text {Source Branches} \
2574                -font font_ui
2575        listbox $w.source.l \
2576                -height 10 \
2577                -width 70 \
2578                -selectmode extended \
2579                -yscrollcommand [list $w.source.sby set] \
2580                -font font_ui
2581        foreach h $all_heads {
2582                $w.source.l insert end $h
2583                if {$h eq $current_branch} {
2584                        $w.source.l select set end
2585                }
2586        }
2587        scrollbar $w.source.sby -command [list $w.source.l yview]
2588        pack $w.source.sby -side right -fill y
2589        pack $w.source.l -side left -fill both -expand 1
2590        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2591
2592        labelframe $w.dest \
2593                -text {Destination Repository} \
2594                -font font_ui
2595        if {$all_remotes ne {}} {
2596                radiobutton $w.dest.remote_r \
2597                        -text {Remote:} \
2598                        -value remote \
2599                        -variable push_urltype \
2600                        -font font_ui
2601                eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2602                grid $w.dest.remote_r $w.dest.remote_m -sticky w
2603                if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2604                        set push_remote origin
2605                } else {
2606                        set push_remote [lindex $all_remotes 0]
2607                }
2608                set push_urltype remote
2609        } else {
2610                set push_urltype url
2611        }
2612        radiobutton $w.dest.url_r \
2613                -text {Arbitrary URL:} \
2614                -value url \
2615                -variable push_urltype \
2616                -font font_ui
2617        entry $w.dest.url_t \
2618                -borderwidth 1 \
2619                -relief sunken \
2620                -width 50 \
2621                -textvariable push_url \
2622                -font font_ui \
2623                -validate key \
2624                -validatecommand {
2625                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2626                        if {%d == 1 && [string length %S] > 0} {
2627                                set push_urltype url
2628                        }
2629                        return 1
2630                }
2631        grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2632        grid columnconfigure $w.dest 1 -weight 1
2633        pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2634
2635        labelframe $w.options \
2636                -text {Transfer Options} \
2637                -font font_ui
2638        checkbutton $w.options.thin \
2639                -text {Use thin pack (for slow network connections)} \
2640                -variable push_thin \
2641                -font font_ui
2642        grid $w.options.thin -columnspan 2 -sticky w
2643        checkbutton $w.options.tags \
2644                -text {Include tags} \
2645                -variable push_tags \
2646                -font font_ui
2647        grid $w.options.tags -columnspan 2 -sticky w
2648        grid columnconfigure $w.options 1 -weight 1
2649        pack $w.options -anchor nw -fill x -pady 5 -padx 5
2650
2651        set push_url {}
2652        set push_thin 0
2653        set push_tags 0
2654
2655        bind $w <Visibility> "grab $w"
2656        bind $w <Key-Escape> "destroy $w"
2657        wm title $w "[appname] ([reponame]): Push"
2658        tkwait window $w
2659}
2660
2661######################################################################
2662##
2663## merge
2664
2665proc can_merge {} {
2666        global HEAD commit_type file_states
2667
2668        if {[string match amend* $commit_type]} {
2669                info_popup {Cannot merge while amending.
2670
2671You must finish amending this commit before
2672starting any type of merge.
2673}
2674                return 0
2675        }
2676
2677        if {[committer_ident] eq {}} {return 0}
2678        if {![lock_index merge]} {return 0}
2679
2680        # -- Our in memory state should match the repository.
2681        #
2682        repository_state curType curHEAD curMERGE_HEAD
2683        if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2684                info_popup {Last scanned state does not match repository state.
2685
2686Another Git program has modified this repository
2687since the last scan.  A rescan must be performed
2688before a merge can be performed.
2689
2690The rescan will be automatically started now.
2691}
2692                unlock_index
2693                rescan {set ui_status_value {Ready.}}
2694                return 0
2695        }
2696
2697        foreach path [array names file_states] {
2698                switch -glob -- [lindex $file_states($path) 0] {
2699                _O {
2700                        continue; # and pray it works!
2701                }
2702                U? {
2703                        error_popup "You are in the middle of a conflicted merge.
2704
2705File [short_path $path] has merge conflicts.
2706
2707You must resolve them, add the file, and commit to
2708complete the current merge.  Only then can you
2709begin another merge.
2710"
2711                        unlock_index
2712                        return 0
2713                }
2714                ?? {
2715                        error_popup "You are in the middle of a change.
2716
2717File [short_path $path] is modified.
2718
2719You should complete the current commit before
2720starting a merge.  Doing so will help you abort
2721a failed merge, should the need arise.
2722"
2723                        unlock_index
2724                        return 0
2725                }
2726                }
2727        }
2728
2729        return 1
2730}
2731
2732proc visualize_local_merge {w} {
2733        set revs {}
2734        foreach i [$w.source.l curselection] {
2735                lappend revs [$w.source.l get $i]
2736        }
2737        if {$revs eq {}} return
2738        lappend revs --not HEAD
2739        do_gitk $revs
2740}
2741
2742proc start_local_merge_action {w} {
2743        global HEAD ui_status_value current_branch
2744
2745        set cmd [list git merge]
2746        set names {}
2747        set revcnt 0
2748        foreach i [$w.source.l curselection] {
2749                set b [$w.source.l get $i]
2750                lappend cmd $b
2751                lappend names $b
2752                incr revcnt
2753        }
2754
2755        if {$revcnt == 0} {
2756                return
2757        } elseif {$revcnt == 1} {
2758                set unit branch
2759        } elseif {$revcnt <= 15} {
2760                set unit branches
2761        } else {
2762                tk_messageBox \
2763                        -icon error \
2764                        -type ok \
2765                        -title [wm title $w] \
2766                        -parent $w \
2767                        -message "Too many branches selected.
2768
2769You have requested to merge $revcnt branches
2770in an octopus merge.  This exceeds Git's
2771internal limit of 15 branches per merge.
2772
2773Please select fewer branches.  To merge more
2774than 15 branches, merge the branches in batches.
2775"
2776                return
2777        }
2778
2779        set msg "Merging $current_branch, [join $names {, }]"
2780        set ui_status_value "$msg..."
2781        set cons [new_console "Merge" $msg]
2782        console_exec $cons $cmd [list finish_merge $revcnt]
2783        bind $w <Destroy> {}
2784        destroy $w
2785}
2786
2787proc finish_merge {revcnt w ok} {
2788        console_done $w $ok
2789        if {$ok} {
2790                set msg {Merge completed successfully.}
2791        } else {
2792                if {$revcnt != 1} {
2793                        info_popup "Octopus merge failed.
2794
2795Your merge of $revcnt branches has failed.
2796
2797There are file-level conflicts between the
2798branches which must be resolved manually.
2799
2800The working directory will now be reset.
2801
2802You can attempt this merge again
2803by merging only one branch at a time." $w
2804
2805                        set fd [open "| git read-tree --reset -u HEAD" r]
2806                        fconfigure $fd -blocking 0 -translation binary
2807                        fileevent $fd readable [list reset_hard_wait $fd]
2808                        set ui_status_value {Aborting... please wait...}
2809                        return
2810                }
2811
2812                set msg {Merge failed.  Conflict resolution is required.}
2813        }
2814        unlock_index
2815        rescan [list set ui_status_value $msg]
2816}
2817
2818proc do_local_merge {} {
2819        global current_branch
2820
2821        if {![can_merge]} return
2822
2823        set w .merge_setup
2824        toplevel $w
2825        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2826
2827        label $w.header \
2828                -text "Merge Into $current_branch" \
2829                -font font_uibold
2830        pack $w.header -side top -fill x
2831
2832        frame $w.buttons
2833        button $w.buttons.visualize -text Visualize \
2834                -font font_ui \
2835                -command [list visualize_local_merge $w]
2836        pack $w.buttons.visualize -side left
2837        button $w.buttons.create -text Merge \
2838                -font font_ui \
2839                -command [list start_local_merge_action $w]
2840        pack $w.buttons.create -side right
2841        button $w.buttons.cancel -text {Cancel} \
2842                -font font_ui \
2843                -command [list destroy $w]
2844        pack $w.buttons.cancel -side right -padx 5
2845        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2846
2847        labelframe $w.source \
2848                -text {Source Branches} \
2849                -font font_ui
2850        listbox $w.source.l \
2851                -height 10 \
2852                -width 70 \
2853                -selectmode extended \
2854                -yscrollcommand [list $w.source.sby set] \
2855                -font font_ui
2856        scrollbar $w.source.sby -command [list $w.source.l yview]
2857        pack $w.source.sby -side right -fill y
2858        pack $w.source.l -side left -fill both -expand 1
2859        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2860
2861        set cmd [list git for-each-ref]
2862        lappend cmd {--format=%(objectname) %(refname)}
2863        lappend cmd refs/heads
2864        lappend cmd refs/remotes
2865        set fr_fd [open "| $cmd" r]
2866        fconfigure $fr_fd -translation binary
2867        while {[gets $fr_fd line] > 0} {
2868                set line [split $line { }]
2869                set sha1([lindex $line 0]) [lindex $line 1]
2870        }
2871        close $fr_fd
2872
2873        set to_show {}
2874        set fr_fd [open "| git rev-list --all --not HEAD"]
2875        while {[gets $fr_fd line] > 0} {
2876                if {[catch {set ref $sha1($line)}]} continue
2877                regsub ^refs/(heads|remotes)/ $ref {} ref
2878                lappend to_show $ref
2879        }
2880        close $fr_fd
2881
2882        foreach ref [lsort -unique $to_show] {
2883                $w.source.l insert end $ref
2884        }
2885
2886        bind $w <Visibility> "grab $w"
2887        bind $w <Key-Escape> "unlock_index;destroy $w"
2888        bind $w <Destroy> unlock_index
2889        wm title $w "[appname] ([reponame]): Merge"
2890        tkwait window $w
2891}
2892
2893proc do_reset_hard {} {
2894        global HEAD commit_type file_states
2895
2896        if {[string match amend* $commit_type]} {
2897                info_popup {Cannot abort while amending.
2898
2899You must finish amending this commit.
2900}
2901                return
2902        }
2903
2904        if {![lock_index abort]} return
2905
2906        if {[string match *merge* $commit_type]} {
2907                set op merge
2908        } else {
2909                set op commit
2910        }
2911
2912        if {[ask_popup "Abort $op?
2913
2914Aborting the current $op will cause
2915*ALL* uncommitted changes to be lost.
2916
2917Continue with aborting the current $op?"] eq {yes}} {
2918                set fd [open "| git read-tree --reset -u HEAD" r]
2919                fconfigure $fd -blocking 0 -translation binary
2920                fileevent $fd readable [list reset_hard_wait $fd]
2921                set ui_status_value {Aborting... please wait...}
2922        } else {
2923                unlock_index
2924        }
2925}
2926
2927proc reset_hard_wait {fd} {
2928        global ui_comm
2929
2930        read $fd
2931        if {[eof $fd]} {
2932                close $fd
2933                unlock_index
2934
2935                $ui_comm delete 0.0 end
2936                $ui_comm edit modified false
2937
2938                catch {file delete [gitdir MERGE_HEAD]}
2939                catch {file delete [gitdir rr-cache MERGE_RR]}
2940                catch {file delete [gitdir SQUASH_MSG]}
2941                catch {file delete [gitdir MERGE_MSG]}
2942                catch {file delete [gitdir GITGUI_MSG]}
2943
2944                rescan {set ui_status_value {Abort completed.  Ready.}}
2945        }
2946}
2947
2948######################################################################
2949##
2950## icons
2951
2952set filemask {
2953#define mask_width 14
2954#define mask_height 15
2955static unsigned char mask_bits[] = {
2956   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2957   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2958   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2959}
2960
2961image create bitmap file_plain -background white -foreground black -data {
2962#define plain_width 14
2963#define plain_height 15
2964static unsigned char plain_bits[] = {
2965   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2966   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2967   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2968} -maskdata $filemask
2969
2970image create bitmap file_mod -background white -foreground blue -data {
2971#define mod_width 14
2972#define mod_height 15
2973static unsigned char mod_bits[] = {
2974   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2975   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2976   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2977} -maskdata $filemask
2978
2979image create bitmap file_fulltick -background white -foreground "#007000" -data {
2980#define file_fulltick_width 14
2981#define file_fulltick_height 15
2982static unsigned char file_fulltick_bits[] = {
2983   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2984   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2985   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2986} -maskdata $filemask
2987
2988image create bitmap file_parttick -background white -foreground "#005050" -data {
2989#define parttick_width 14
2990#define parttick_height 15
2991static unsigned char parttick_bits[] = {
2992   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2993   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2994   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2995} -maskdata $filemask
2996
2997image create bitmap file_question -background white -foreground black -data {
2998#define file_question_width 14
2999#define file_question_height 15
3000static unsigned char file_question_bits[] = {
3001   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3002   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3003   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3004} -maskdata $filemask
3005
3006image create bitmap file_removed -background white -foreground red -data {
3007#define file_removed_width 14
3008#define file_removed_height 15
3009static unsigned char file_removed_bits[] = {
3010   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3011   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3012   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3013} -maskdata $filemask
3014
3015image create bitmap file_merge -background white -foreground blue -data {
3016#define file_merge_width 14
3017#define file_merge_height 15
3018static unsigned char file_merge_bits[] = {
3019   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3020   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3021   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3022} -maskdata $filemask
3023
3024set ui_index .vpane.files.index.list
3025set ui_workdir .vpane.files.workdir.list
3026
3027set all_icons(_$ui_index)   file_plain
3028set all_icons(A$ui_index)   file_fulltick
3029set all_icons(M$ui_index)   file_fulltick
3030set all_icons(D$ui_index)   file_removed
3031set all_icons(U$ui_index)   file_merge
3032
3033set all_icons(_$ui_workdir) file_plain
3034set all_icons(M$ui_workdir) file_mod
3035set all_icons(D$ui_workdir) file_question
3036set all_icons(U$ui_workdir) file_merge
3037set all_icons(O$ui_workdir) file_plain
3038
3039set max_status_desc 0
3040foreach i {
3041                {__ "Unmodified"}
3042
3043                {_M "Modified, not staged"}
3044                {M_ "Staged for commit"}
3045                {MM "Portions staged for commit"}
3046                {MD "Staged for commit, missing"}
3047
3048                {_O "Untracked, not staged"}
3049                {A_ "Staged for commit"}
3050                {AM "Portions staged for commit"}
3051                {AD "Staged for commit, missing"}
3052
3053                {_D "Missing"}
3054                {D_ "Staged for removal"}
3055                {DO "Staged for removal, still present"}
3056
3057                {U_ "Requires merge resolution"}
3058                {UU "Requires merge resolution"}
3059                {UM "Requires merge resolution"}
3060                {UD "Requires merge resolution"}
3061        } {
3062        if {$max_status_desc < [string length [lindex $i 1]]} {
3063                set max_status_desc [string length [lindex $i 1]]
3064        }
3065        set all_descs([lindex $i 0]) [lindex $i 1]
3066}
3067unset i
3068
3069######################################################################
3070##
3071## util
3072
3073proc bind_button3 {w cmd} {
3074        bind $w <Any-Button-3> $cmd
3075        if {[is_MacOSX]} {
3076                bind $w <Control-Button-1> $cmd
3077        }
3078}
3079
3080proc incr_font_size {font {amt 1}} {
3081        set sz [font configure $font -size]
3082        incr sz $amt
3083        font configure $font -size $sz
3084        font configure ${font}bold -size $sz
3085}
3086
3087proc hook_failed_popup {hook msg} {
3088        set w .hookfail
3089        toplevel $w
3090
3091        frame $w.m
3092        label $w.m.l1 -text "$hook hook failed:" \
3093                -anchor w \
3094                -justify left \
3095                -font font_uibold
3096        text $w.m.t \
3097                -background white -borderwidth 1 \
3098                -relief sunken \
3099                -width 80 -height 10 \
3100                -font font_diff \
3101                -yscrollcommand [list $w.m.sby set]
3102        label $w.m.l2 \
3103                -text {You must correct the above errors before committing.} \
3104                -anchor w \
3105                -justify left \
3106                -font font_uibold
3107        scrollbar $w.m.sby -command [list $w.m.t yview]
3108        pack $w.m.l1 -side top -fill x
3109        pack $w.m.l2 -side bottom -fill x
3110        pack $w.m.sby -side right -fill y
3111        pack $w.m.t -side left -fill both -expand 1
3112        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3113
3114        $w.m.t insert 1.0 $msg
3115        $w.m.t conf -state disabled
3116
3117        button $w.ok -text OK \
3118                -width 15 \
3119                -font font_ui \
3120                -command "destroy $w"
3121        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3122
3123        bind $w <Visibility> "grab $w; focus $w"
3124        bind $w <Key-Return> "destroy $w"
3125        wm title $w "[appname] ([reponame]): error"
3126        tkwait window $w
3127}
3128
3129set next_console_id 0
3130
3131proc new_console {short_title long_title} {
3132        global next_console_id console_data
3133        set w .console[incr next_console_id]
3134        set console_data($w) [list $short_title $long_title]
3135        return [console_init $w]
3136}
3137
3138proc console_init {w} {
3139        global console_cr console_data M1B
3140
3141        set console_cr($w) 1.0
3142        toplevel $w
3143        frame $w.m
3144        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3145                -anchor w \
3146                -justify left \
3147                -font font_uibold
3148        text $w.m.t \
3149                -background white -borderwidth 1 \
3150                -relief sunken \
3151                -width 80 -height 10 \
3152                -font font_diff \
3153                -state disabled \
3154                -yscrollcommand [list $w.m.sby set]
3155        label $w.m.s -text {Working... please wait...} \
3156                -anchor w \
3157                -justify left \
3158                -font font_uibold
3159        scrollbar $w.m.sby -command [list $w.m.t yview]
3160        pack $w.m.l1 -side top -fill x
3161        pack $w.m.s -side bottom -fill x
3162        pack $w.m.sby -side right -fill y
3163        pack $w.m.t -side left -fill both -expand 1
3164        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3165
3166        menu $w.ctxm -tearoff 0
3167        $w.ctxm add command -label "Copy" \
3168                -font font_ui \
3169                -command "tk_textCopy $w.m.t"
3170        $w.ctxm add command -label "Select All" \
3171                -font font_ui \
3172                -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3173        $w.ctxm add command -label "Copy All" \
3174                -font font_ui \
3175                -command "
3176                        $w.m.t tag add sel 0.0 end
3177                        tk_textCopy $w.m.t
3178                        $w.m.t tag remove sel 0.0 end
3179                "
3180
3181        button $w.ok -text {Close} \
3182                -font font_ui \
3183                -state disabled \
3184                -command "destroy $w"
3185        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3186
3187        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3188        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3189        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3190        bind $w <Visibility> "focus $w"
3191        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3192        return $w
3193}
3194
3195proc console_exec {w cmd after} {
3196        # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3197        #    But most users need that so we have to relogin. :-(
3198        #
3199        if {[is_Cygwin]} {
3200                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3201        }
3202
3203        # -- Tcl won't let us redirect both stdout and stderr to
3204        #    the same pipe.  So pass it through cat...
3205        #
3206        set cmd [concat | $cmd |& cat]
3207
3208        set fd_f [open $cmd r]
3209        fconfigure $fd_f -blocking 0 -translation binary
3210        fileevent $fd_f readable [list console_read $w $fd_f $after]
3211}
3212
3213proc console_read {w fd after} {
3214        global console_cr
3215
3216        set buf [read $fd]
3217        if {$buf ne {}} {
3218                if {![winfo exists $w]} {console_init $w}
3219                $w.m.t conf -state normal
3220                set c 0
3221                set n [string length $buf]
3222                while {$c < $n} {
3223                        set cr [string first "\r" $buf $c]
3224                        set lf [string first "\n" $buf $c]
3225                        if {$cr < 0} {set cr [expr {$n + 1}]}
3226                        if {$lf < 0} {set lf [expr {$n + 1}]}
3227
3228                        if {$lf < $cr} {
3229                                $w.m.t insert end [string range $buf $c $lf]
3230                                set console_cr($w) [$w.m.t index {end -1c}]
3231                                set c $lf
3232                                incr c
3233                        } else {
3234                                $w.m.t delete $console_cr($w) end
3235                                $w.m.t insert end "\n"
3236                                $w.m.t insert end [string range $buf $c $cr]
3237                                set c $cr
3238                                incr c
3239                        }
3240                }
3241                $w.m.t conf -state disabled
3242                $w.m.t see end
3243        }
3244
3245        fconfigure $fd -blocking 1
3246        if {[eof $fd]} {
3247                if {[catch {close $fd}]} {
3248                        set ok 0
3249                } else {
3250                        set ok 1
3251                }
3252                uplevel #0 $after $w $ok
3253                return
3254        }
3255        fconfigure $fd -blocking 0
3256}
3257
3258proc console_chain {cmdlist w {ok 1}} {
3259        if {$ok} {
3260                if {[llength $cmdlist] == 0} {
3261                        console_done $w $ok
3262                        return
3263                }
3264
3265                set cmd [lindex $cmdlist 0]
3266                set cmdlist [lrange $cmdlist 1 end]
3267
3268                if {[lindex $cmd 0] eq {console_exec}} {
3269                        console_exec $w \
3270                                [lindex $cmd 1] \
3271                                [list console_chain $cmdlist]
3272                } else {
3273                        uplevel #0 $cmd $cmdlist $w $ok
3274                }
3275        } else {
3276                console_done $w $ok
3277        }
3278}
3279
3280proc console_done {args} {
3281        global console_cr console_data
3282
3283        switch -- [llength $args] {
3284        2 {
3285                set w [lindex $args 0]
3286                set ok [lindex $args 1]
3287        }
3288        3 {
3289                set w [lindex $args 1]
3290                set ok [lindex $args 2]
3291        }
3292        default {
3293                error "wrong number of args: console_done ?ignored? w ok"
3294        }
3295        }
3296
3297        if {$ok} {
3298                if {[winfo exists $w]} {
3299                        $w.m.s conf -background green -text {Success}
3300                        $w.ok conf -state normal
3301                }
3302        } else {
3303                if {![winfo exists $w]} {
3304                        console_init $w
3305                }
3306                $w.m.s conf -background red -text {Error: Command Failed}
3307                $w.ok conf -state normal
3308        }
3309
3310        array unset console_cr $w
3311        array unset console_data $w
3312}
3313
3314######################################################################
3315##
3316## ui commands
3317
3318set starting_gitk_msg {Starting gitk... please wait...}
3319
3320proc do_gitk {revs} {
3321        global env ui_status_value starting_gitk_msg
3322
3323        # -- On Windows gitk is severly broken, and right now it seems like
3324        #    nobody cares about fixing it.  The only known workaround is to
3325        #    always delete ~/.gitk before starting the program.
3326        #
3327        if {[is_Windows]} {
3328                catch {file delete [file join $env(HOME) .gitk]}
3329        }
3330
3331        # -- Always start gitk through whatever we were loaded with.  This
3332        #    lets us bypass using shell process on Windows systems.
3333        #
3334        set cmd [info nameofexecutable]
3335        lappend cmd [gitexec gitk]
3336        if {$revs ne {}} {
3337                append cmd { }
3338                append cmd $revs
3339        }
3340
3341        if {[catch {eval exec $cmd &} err]} {
3342                error_popup "Failed to start gitk:\n\n$err"
3343        } else {
3344                set ui_status_value $starting_gitk_msg
3345                after 10000 {
3346                        if {$ui_status_value eq $starting_gitk_msg} {
3347                                set ui_status_value {Ready.}
3348                        }
3349                }
3350        }
3351}
3352
3353proc do_stats {} {
3354        set fd [open "| git count-objects -v" r]
3355        while {[gets $fd line] > 0} {
3356                if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
3357                        set stats($name) $value
3358                }
3359        }
3360        close $fd
3361
3362        set packed_sz 0
3363        foreach p [glob -directory [gitdir objects pack] \
3364                -type f \
3365                -nocomplain -- *] {
3366                incr packed_sz [file size $p]
3367        }
3368        if {$packed_sz > 0} {
3369                set stats(size-pack) [expr {$packed_sz / 1024}]
3370        }
3371
3372        set w .stats_view
3373        toplevel $w
3374        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3375
3376        label $w.header -text {Database Statistics} \
3377                -font font_uibold
3378        pack $w.header -side top -fill x
3379
3380        frame $w.buttons -border 1
3381        button $w.buttons.close -text Close \
3382                -font font_ui \
3383                -command [list destroy $w]
3384        button $w.buttons.gc -text {Compress Database} \
3385                -font font_ui \
3386                -command "destroy $w;do_gc"
3387        pack $w.buttons.close -side right
3388        pack $w.buttons.gc -side left
3389        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3390
3391        frame $w.stat -borderwidth 1 -relief solid
3392        foreach s {
3393                {count           {Number of loose objects}}
3394                {size            {Disk space used by loose objects} { KiB}}
3395                {in-pack         {Number of packed objects}}
3396                {packs           {Number of packs}}
3397                {size-pack       {Disk space used by packed objects} { KiB}}
3398                {prune-packable  {Packed objects waiting for pruning}}
3399                {garbage         {Garbage files}}
3400                } {
3401                set name [lindex $s 0]
3402                set label [lindex $s 1]
3403                if {[catch {set value $stats($name)}]} continue
3404                if {[llength $s] > 2} {
3405                        set value "$value[lindex $s 2]"
3406                }
3407
3408                label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
3409                label $w.stat.v_$name -text $value -anchor w -font font_ui
3410                grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
3411        }
3412        pack $w.stat -pady 10 -padx 10
3413
3414        bind $w <Visibility> "grab $w; focus $w"
3415        bind $w <Key-Escape> [list destroy $w]
3416        bind $w <Key-Return> [list destroy $w]
3417        wm title $w "[appname] ([reponame]): Database Statistics"
3418        tkwait window $w
3419}
3420
3421proc do_gc {} {
3422        set w [new_console {gc} {Compressing the object database}]
3423        console_chain {
3424                {console_exec {git pack-refs --prune}}
3425                {console_exec {git reflog expire --all}}
3426                {console_exec {git repack -a -d -l}}
3427                {console_exec {git rerere gc}}
3428        } $w
3429}
3430
3431proc do_fsck_objects {} {
3432        set w [new_console {fsck-objects} \
3433                {Verifying the object database with fsck-objects}]
3434        set cmd [list git fsck-objects]
3435        lappend cmd --full
3436        lappend cmd --cache
3437        lappend cmd --strict
3438        console_exec $w $cmd console_done
3439}
3440
3441set is_quitting 0
3442
3443proc do_quit {} {
3444        global ui_comm is_quitting repo_config commit_type
3445
3446        if {$is_quitting} return
3447        set is_quitting 1
3448
3449        # -- Stash our current commit buffer.
3450        #
3451        set save [gitdir GITGUI_MSG]
3452        set msg [string trim [$ui_comm get 0.0 end]]
3453        regsub -all -line {[ \r\t]+$} $msg {} msg
3454        if {(![string match amend* $commit_type]
3455                || [$ui_comm edit modified])
3456                && $msg ne {}} {
3457                catch {
3458                        set fd [open $save w]
3459                        puts -nonewline $fd $msg
3460                        close $fd
3461                }
3462        } else {
3463                catch {file delete $save}
3464        }
3465
3466        # -- Stash our current window geometry into this repository.
3467        #
3468        set cfg_geometry [list]
3469        lappend cfg_geometry [wm geometry .]
3470        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
3471        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
3472        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
3473                set rc_geometry {}
3474        }
3475        if {$cfg_geometry ne $rc_geometry} {
3476                catch {exec git repo-config gui.geometry $cfg_geometry}
3477        }
3478
3479        destroy .
3480}
3481
3482proc do_rescan {} {
3483        rescan {set ui_status_value {Ready.}}
3484}
3485
3486proc unstage_helper {txt paths} {
3487        global file_states current_diff_path
3488
3489        if {![lock_index begin-update]} return
3490
3491        set pathList [list]
3492        set after {}
3493        foreach path $paths {
3494                switch -glob -- [lindex $file_states($path) 0] {
3495                A? -
3496                M? -
3497                D? {
3498                        lappend pathList $path
3499                        if {$path eq $current_diff_path} {
3500                                set after {reshow_diff;}
3501                        }
3502                }
3503                }
3504        }
3505        if {$pathList eq {}} {
3506                unlock_index
3507        } else {
3508                update_indexinfo \
3509                        $txt \
3510                        $pathList \
3511                        [concat $after {set ui_status_value {Ready.}}]
3512        }
3513}
3514
3515proc do_unstage_selection {} {
3516        global current_diff_path selected_paths
3517
3518        if {[array size selected_paths] > 0} {
3519                unstage_helper \
3520                        {Unstaging selected files from commit} \
3521                        [array names selected_paths]
3522        } elseif {$current_diff_path ne {}} {
3523                unstage_helper \
3524                        "Unstaging [short_path $current_diff_path] from commit" \
3525                        [list $current_diff_path]
3526        }
3527}
3528
3529proc add_helper {txt paths} {
3530        global file_states current_diff_path
3531
3532        if {![lock_index begin-update]} return
3533
3534        set pathList [list]
3535        set after {}
3536        foreach path $paths {
3537                switch -glob -- [lindex $file_states($path) 0] {
3538                _O -
3539                ?M -
3540                ?D -
3541                U? {
3542                        lappend pathList $path
3543                        if {$path eq $current_diff_path} {
3544                                set after {reshow_diff;}
3545                        }
3546                }
3547                }
3548        }
3549        if {$pathList eq {}} {
3550                unlock_index
3551        } else {
3552                update_index \
3553                        $txt \
3554                        $pathList \
3555                        [concat $after {set ui_status_value {Ready to commit.}}]
3556        }
3557}
3558
3559proc do_add_selection {} {
3560        global current_diff_path selected_paths
3561
3562        if {[array size selected_paths] > 0} {
3563                add_helper \
3564                        {Adding selected files} \
3565                        [array names selected_paths]
3566        } elseif {$current_diff_path ne {}} {
3567                add_helper \
3568                        "Adding [short_path $current_diff_path]" \
3569                        [list $current_diff_path]
3570        }
3571}
3572
3573proc do_add_all {} {
3574        global file_states
3575
3576        set paths [list]
3577        foreach path [array names file_states] {
3578                switch -glob -- [lindex $file_states($path) 0] {
3579                U? {continue}
3580                ?M -
3581                ?D {lappend paths $path}
3582                }
3583        }
3584        add_helper {Adding all changed files} $paths
3585}
3586
3587proc revert_helper {txt paths} {
3588        global file_states current_diff_path
3589
3590        if {![lock_index begin-update]} return
3591
3592        set pathList [list]
3593        set after {}
3594        foreach path $paths {
3595                switch -glob -- [lindex $file_states($path) 0] {
3596                U? {continue}
3597                ?M -
3598                ?D {
3599                        lappend pathList $path
3600                        if {$path eq $current_diff_path} {
3601                                set after {reshow_diff;}
3602                        }
3603                }
3604                }
3605        }
3606
3607        set n [llength $pathList]
3608        if {$n == 0} {
3609                unlock_index
3610                return
3611        } elseif {$n == 1} {
3612                set s "[short_path [lindex $pathList]]"
3613        } else {
3614                set s "these $n files"
3615        }
3616
3617        set reply [tk_dialog \
3618                .confirm_revert \
3619                "[appname] ([reponame])" \
3620                "Revert changes in $s?
3621
3622Any unadded changes will be permanently lost by the revert." \
3623                question \
3624                1 \
3625                {Do Nothing} \
3626                {Revert Changes} \
3627                ]
3628        if {$reply == 1} {
3629                checkout_index \
3630                        $txt \
3631                        $pathList \
3632                        [concat $after {set ui_status_value {Ready.}}]
3633        } else {
3634                unlock_index
3635        }
3636}
3637
3638proc do_revert_selection {} {
3639        global current_diff_path selected_paths
3640
3641        if {[array size selected_paths] > 0} {
3642                revert_helper \
3643                        {Reverting selected files} \
3644                        [array names selected_paths]
3645        } elseif {$current_diff_path ne {}} {
3646                revert_helper \
3647                        "Reverting [short_path $current_diff_path]" \
3648                        [list $current_diff_path]
3649        }
3650}
3651
3652proc do_signoff {} {
3653        global ui_comm
3654
3655        set me [committer_ident]
3656        if {$me eq {}} return
3657
3658        set sob "Signed-off-by: $me"
3659        set last [$ui_comm get {end -1c linestart} {end -1c}]
3660        if {$last ne $sob} {
3661                $ui_comm edit separator
3662                if {$last ne {}
3663                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
3664                        $ui_comm insert end "\n"
3665                }
3666                $ui_comm insert end "\n$sob"
3667                $ui_comm edit separator
3668                $ui_comm see end
3669        }
3670}
3671
3672proc do_select_commit_type {} {
3673        global commit_type selected_commit_type
3674
3675        if {$selected_commit_type eq {new}
3676                && [string match amend* $commit_type]} {
3677                create_new_commit
3678        } elseif {$selected_commit_type eq {amend}
3679                && ![string match amend* $commit_type]} {
3680                load_last_commit
3681
3682                # The amend request was rejected...
3683                #
3684                if {![string match amend* $commit_type]} {
3685                        set selected_commit_type new
3686                }
3687        }
3688}
3689
3690proc do_commit {} {
3691        commit_tree
3692}
3693
3694proc do_about {} {
3695        global appvers copyright
3696        global tcl_patchLevel tk_patchLevel
3697
3698        set w .about_dialog
3699        toplevel $w
3700        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3701
3702        label $w.header -text "About [appname]" \
3703                -font font_uibold
3704        pack $w.header -side top -fill x
3705
3706        frame $w.buttons
3707        button $w.buttons.close -text {Close} \
3708                -font font_ui \
3709                -command [list destroy $w]
3710        pack $w.buttons.close -side right
3711        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3712
3713        label $w.desc \
3714                -text "[appname] - a commit creation tool for Git.
3715$copyright" \
3716                -padx 5 -pady 5 \
3717                -justify left \
3718                -anchor w \
3719                -borderwidth 1 \
3720                -relief solid \
3721                -font font_ui
3722        pack $w.desc -side top -fill x -padx 5 -pady 5
3723
3724        set v {}
3725        append v "[appname] version $appvers\n"
3726        append v "[exec git version]\n"
3727        append v "\n"
3728        if {$tcl_patchLevel eq $tk_patchLevel} {
3729                append v "Tcl/Tk version $tcl_patchLevel"
3730        } else {
3731                append v "Tcl version $tcl_patchLevel"
3732                append v ", Tk version $tk_patchLevel"
3733        }
3734
3735        label $w.vers \
3736                -text $v \
3737                -padx 5 -pady 5 \
3738                -justify left \
3739                -anchor w \
3740                -borderwidth 1 \
3741                -relief solid \
3742                -font font_ui
3743        pack $w.vers -side top -fill x -padx 5 -pady 5
3744
3745        menu $w.ctxm -tearoff 0
3746        $w.ctxm add command \
3747                -label {Copy} \
3748                -font font_ui \
3749                -command "
3750                clipboard clear
3751                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3752        "
3753
3754        bind $w <Visibility> "grab $w; focus $w"
3755        bind $w <Key-Escape> "destroy $w"
3756        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3757        wm title $w "About [appname]"
3758        tkwait window $w
3759}
3760
3761proc do_options {} {
3762        global repo_config global_config font_descs
3763        global repo_config_new global_config_new
3764
3765        array unset repo_config_new
3766        array unset global_config_new
3767        foreach name [array names repo_config] {
3768                set repo_config_new($name) $repo_config($name)
3769        }
3770        load_config 1
3771        foreach name [array names repo_config] {
3772                switch -- $name {
3773                gui.diffcontext {continue}
3774                }
3775                set repo_config_new($name) $repo_config($name)
3776        }
3777        foreach name [array names global_config] {
3778                set global_config_new($name) $global_config($name)
3779        }
3780
3781        set w .options_editor
3782        toplevel $w
3783        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3784
3785        label $w.header -text "[appname] Options" \
3786                -font font_uibold
3787        pack $w.header -side top -fill x
3788
3789        frame $w.buttons
3790        button $w.buttons.restore -text {Restore Defaults} \
3791                -font font_ui \
3792                -command do_restore_defaults
3793        pack $w.buttons.restore -side left
3794        button $w.buttons.save -text Save \
3795                -font font_ui \
3796                -command [list do_save_config $w]
3797        pack $w.buttons.save -side right
3798        button $w.buttons.cancel -text {Cancel} \
3799                -font font_ui \
3800                -command [list destroy $w]
3801        pack $w.buttons.cancel -side right -padx 5
3802        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3803
3804        labelframe $w.repo -text "[reponame] Repository" \
3805                -font font_ui
3806        labelframe $w.global -text {Global (All Repositories)} \
3807                -font font_ui
3808        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3809        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3810
3811        set optid 0
3812        foreach option {
3813                {b merge.summary {Summarize Merge Commits}}
3814                {i-1..5 merge.verbosity {Merge Verbosity}}
3815
3816                {b gui.trustmtime  {Trust File Modification Timestamps}}
3817                {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
3818                {t gui.newbranchtemplate {New Branch Name Template}}
3819                } {
3820                set type [lindex $option 0]
3821                set name [lindex $option 1]
3822                set text [lindex $option 2]
3823                incr optid
3824                foreach f {repo global} {
3825                        switch -glob -- $type {
3826                        b {
3827                                checkbutton $w.$f.$optid -text $text \
3828                                        -variable ${f}_config_new($name) \
3829                                        -onvalue true \
3830                                        -offvalue false \
3831                                        -font font_ui
3832                                pack $w.$f.$optid -side top -anchor w
3833                        }
3834                        i-* {
3835                                regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
3836                                frame $w.$f.$optid
3837                                label $w.$f.$optid.l -text "$text:" -font font_ui
3838                                pack $w.$f.$optid.l -side left -anchor w -fill x
3839                                spinbox $w.$f.$optid.v \
3840                                        -textvariable ${f}_config_new($name) \
3841                                        -from $min \
3842                                        -to $max \
3843                                        -increment 1 \
3844                                        -width [expr {1 + [string length $max]}] \
3845                                        -font font_ui
3846                                bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
3847                                pack $w.$f.$optid.v -side right -anchor e -padx 5
3848                                pack $w.$f.$optid -side top -anchor w -fill x
3849                        }
3850                        t {
3851                                frame $w.$f.$optid
3852                                label $w.$f.$optid.l -text "$text:" -font font_ui
3853                                entry $w.$f.$optid.v \
3854                                        -borderwidth 1 \
3855                                        -relief sunken \
3856                                        -width 20 \
3857                                        -textvariable ${f}_config_new($name) \
3858                                        -font font_ui
3859                                pack $w.$f.$optid.l -side left -anchor w
3860                                pack $w.$f.$optid.v -side left -anchor w \
3861                                        -fill x -expand 1 \
3862                                        -padx 5
3863                                pack $w.$f.$optid -side top -anchor w -fill x
3864                        }
3865                        }
3866                }
3867        }
3868
3869        set all_fonts [lsort [font families]]
3870        foreach option $font_descs {
3871                set name [lindex $option 0]
3872                set font [lindex $option 1]
3873                set text [lindex $option 2]
3874
3875                set global_config_new(gui.$font^^family) \
3876                        [font configure $font -family]
3877                set global_config_new(gui.$font^^size) \
3878                        [font configure $font -size]
3879
3880                frame $w.global.$name
3881                label $w.global.$name.l -text "$text:" -font font_ui
3882                pack $w.global.$name.l -side left -anchor w -fill x
3883                eval tk_optionMenu $w.global.$name.family \
3884                        global_config_new(gui.$font^^family) \
3885                        $all_fonts
3886                spinbox $w.global.$name.size \
3887                        -textvariable global_config_new(gui.$font^^size) \
3888                        -from 2 -to 80 -increment 1 \
3889                        -width 3 \
3890                        -font font_ui
3891                bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3892                pack $w.global.$name.size -side right -anchor e
3893                pack $w.global.$name.family -side right -anchor e
3894                pack $w.global.$name -side top -anchor w -fill x
3895        }
3896
3897        bind $w <Visibility> "grab $w; focus $w"
3898        bind $w <Key-Escape> "destroy $w"
3899        wm title $w "[appname] ([reponame]): Options"
3900        tkwait window $w
3901}
3902
3903proc do_restore_defaults {} {
3904        global font_descs default_config repo_config
3905        global repo_config_new global_config_new
3906
3907        foreach name [array names default_config] {
3908                set repo_config_new($name) $default_config($name)
3909                set global_config_new($name) $default_config($name)
3910        }
3911
3912        foreach option $font_descs {
3913                set name [lindex $option 0]
3914                set repo_config(gui.$name) $default_config(gui.$name)
3915        }
3916        apply_config
3917
3918        foreach option $font_descs {
3919                set name [lindex $option 0]
3920                set font [lindex $option 1]
3921                set global_config_new(gui.$font^^family) \
3922                        [font configure $font -family]
3923                set global_config_new(gui.$font^^size) \
3924                        [font configure $font -size]
3925        }
3926}
3927
3928proc do_save_config {w} {
3929        if {[catch {save_config} err]} {
3930                error_popup "Failed to completely save options:\n\n$err"
3931        }
3932        reshow_diff
3933        destroy $w
3934}
3935
3936proc do_windows_shortcut {} {
3937        global argv0
3938
3939        set fn [tk_getSaveFile \
3940                -parent . \
3941                -title "[appname] ([reponame]): Create Desktop Icon" \
3942                -initialfile "Git [reponame].bat"]
3943        if {$fn != {}} {
3944                if {[catch {
3945                                set fd [open $fn w]
3946                                puts $fd "@ECHO Entering [reponame]"
3947                                puts $fd "@ECHO Starting git-gui... please wait..."
3948                                puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
3949                                puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
3950                                puts -nonewline $fd "@\"[info nameofexecutable]\""
3951                                puts $fd " \"[file normalize $argv0]\""
3952                                close $fd
3953                        } err]} {
3954                        error_popup "Cannot write script:\n\n$err"
3955                }
3956        }
3957}
3958
3959proc do_cygwin_shortcut {} {
3960        global argv0
3961
3962        if {[catch {
3963                set desktop [exec cygpath \
3964                        --windows \
3965                        --absolute \
3966                        --long-name \
3967                        --desktop]
3968                }]} {
3969                        set desktop .
3970        }
3971        set fn [tk_getSaveFile \
3972                -parent . \
3973                -title "[appname] ([reponame]): Create Desktop Icon" \
3974                -initialdir $desktop \
3975                -initialfile "Git [reponame].bat"]
3976        if {$fn != {}} {
3977                if {[catch {
3978                                set fd [open $fn w]
3979                                set sh [exec cygpath \
3980                                        --windows \
3981                                        --absolute \
3982                                        /bin/sh]
3983                                set me [exec cygpath \
3984                                        --unix \
3985                                        --absolute \
3986                                        $argv0]
3987                                set gd [exec cygpath \
3988                                        --unix \
3989                                        --absolute \
3990                                        [gitdir]]
3991                                set gw [exec cygpath \
3992                                        --windows \
3993                                        --absolute \
3994                                        [file dirname [gitdir]]]
3995                                regsub -all ' $me "'\\''" me
3996                                regsub -all ' $gd "'\\''" gd
3997                                puts $fd "@ECHO Entering $gw"
3998                                puts $fd "@ECHO Starting git-gui... please wait..."
3999                                puts -nonewline $fd "@\"$sh\" --login -c \""
4000                                puts -nonewline $fd "GIT_DIR='$gd'"
4001                                puts -nonewline $fd " '$me'"
4002                                puts $fd "&\""
4003                                close $fd
4004                        } err]} {
4005                        error_popup "Cannot write script:\n\n$err"
4006                }
4007        }
4008}
4009
4010proc do_macosx_app {} {
4011        global argv0 env
4012
4013        set fn [tk_getSaveFile \
4014                -parent . \
4015                -title "[appname] ([reponame]): Create Desktop Icon" \
4016                -initialdir [file join $env(HOME) Desktop] \
4017                -initialfile "Git [reponame].app"]
4018        if {$fn != {}} {
4019                if {[catch {
4020                                set Contents [file join $fn Contents]
4021                                set MacOS [file join $Contents MacOS]
4022                                set exe [file join $MacOS git-gui]
4023
4024                                file mkdir $MacOS
4025
4026                                set fd [open [file join $Contents Info.plist] w]
4027                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4028<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4029<plist version="1.0">
4030<dict>
4031        <key>CFBundleDevelopmentRegion</key>
4032        <string>English</string>
4033        <key>CFBundleExecutable</key>
4034        <string>git-gui</string>
4035        <key>CFBundleIdentifier</key>
4036        <string>org.spearce.git-gui</string>
4037        <key>CFBundleInfoDictionaryVersion</key>
4038        <string>6.0</string>
4039        <key>CFBundlePackageType</key>
4040        <string>APPL</string>
4041        <key>CFBundleSignature</key>
4042        <string>????</string>
4043        <key>CFBundleVersion</key>
4044        <string>1.0</string>
4045        <key>NSPrincipalClass</key>
4046        <string>NSApplication</string>
4047</dict>
4048</plist>}
4049                                close $fd
4050
4051                                set fd [open $exe w]
4052                                set gd [file normalize [gitdir]]
4053                                set ep [file normalize [gitexec]]
4054                                regsub -all ' $gd "'\\''" gd
4055                                regsub -all ' $ep "'\\''" ep
4056                                puts $fd "#!/bin/sh"
4057                                foreach name [array names env] {
4058                                        if {[string match GIT_* $name]} {
4059                                                regsub -all ' $env($name) "'\\''" v
4060                                                puts $fd "export $name='$v'"
4061                                        }
4062                                }
4063                                puts $fd "export PATH='$ep':\$PATH"
4064                                puts $fd "export GIT_DIR='$gd'"
4065                                puts $fd "exec [file normalize $argv0]"
4066                                close $fd
4067
4068                                file attributes $exe -permissions u+x,g+x,o+x
4069                        } err]} {
4070                        error_popup "Cannot write icon:\n\n$err"
4071                }
4072        }
4073}
4074
4075proc toggle_or_diff {w x y} {
4076        global file_states file_lists current_diff_path ui_index ui_workdir
4077        global last_clicked selected_paths
4078
4079        set pos [split [$w index @$x,$y] .]
4080        set lno [lindex $pos 0]
4081        set col [lindex $pos 1]
4082        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4083        if {$path eq {}} {
4084                set last_clicked {}
4085                return
4086        }
4087
4088        set last_clicked [list $w $lno]
4089        array unset selected_paths
4090        $ui_index tag remove in_sel 0.0 end
4091        $ui_workdir tag remove in_sel 0.0 end
4092
4093        if {$col == 0} {
4094                if {$current_diff_path eq $path} {
4095                        set after {reshow_diff;}
4096                } else {
4097                        set after {}
4098                }
4099                if {$w eq $ui_index} {
4100                        update_indexinfo \
4101                                "Unstaging [short_path $path] from commit" \
4102                                [list $path] \
4103                                [concat $after {set ui_status_value {Ready.}}]
4104                } elseif {$w eq $ui_workdir} {
4105                        update_index \
4106                                "Adding [short_path $path]" \
4107                                [list $path] \
4108                                [concat $after {set ui_status_value {Ready.}}]
4109                }
4110        } else {
4111                show_diff $path $w $lno
4112        }
4113}
4114
4115proc add_one_to_selection {w x y} {
4116        global file_lists last_clicked selected_paths
4117
4118        set lno [lindex [split [$w index @$x,$y] .] 0]
4119        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4120        if {$path eq {}} {
4121                set last_clicked {}
4122                return
4123        }
4124
4125        if {$last_clicked ne {}
4126                && [lindex $last_clicked 0] ne $w} {
4127                array unset selected_paths
4128                [lindex $last_clicked 0] tag remove in_sel 0.0 end
4129        }
4130
4131        set last_clicked [list $w $lno]
4132        if {[catch {set in_sel $selected_paths($path)}]} {
4133                set in_sel 0
4134        }
4135        if {$in_sel} {
4136                unset selected_paths($path)
4137                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4138        } else {
4139                set selected_paths($path) 1
4140                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4141        }
4142}
4143
4144proc add_range_to_selection {w x y} {
4145        global file_lists last_clicked selected_paths
4146
4147        if {[lindex $last_clicked 0] ne $w} {
4148                toggle_or_diff $w $x $y
4149                return
4150        }
4151
4152        set lno [lindex [split [$w index @$x,$y] .] 0]
4153        set lc [lindex $last_clicked 1]
4154        if {$lc < $lno} {
4155                set begin $lc
4156                set end $lno
4157        } else {
4158                set begin $lno
4159                set end $lc
4160        }
4161
4162        foreach path [lrange $file_lists($w) \
4163                [expr {$begin - 1}] \
4164                [expr {$end - 1}]] {
4165                set selected_paths($path) 1
4166        }
4167        $w tag add in_sel $begin.0 [expr {$end + 1}].0
4168}
4169
4170######################################################################
4171##
4172## config defaults
4173
4174set cursor_ptr arrow
4175font create font_diff -family Courier -size 10
4176font create font_ui
4177catch {
4178        label .dummy
4179        eval font configure font_ui [font actual [.dummy cget -font]]
4180        destroy .dummy
4181}
4182
4183font create font_uibold
4184font create font_diffbold
4185
4186if {[is_Windows]} {
4187        set M1B Control
4188        set M1T Ctrl
4189} elseif {[is_MacOSX]} {
4190        set M1B M1
4191        set M1T Cmd
4192} else {
4193        set M1B M1
4194        set M1T M1
4195}
4196
4197proc apply_config {} {
4198        global repo_config font_descs
4199
4200        foreach option $font_descs {
4201                set name [lindex $option 0]
4202                set font [lindex $option 1]
4203                if {[catch {
4204                        foreach {cn cv} $repo_config(gui.$name) {
4205                                font configure $font $cn $cv
4206                        }
4207                        } err]} {
4208                        error_popup "Invalid font specified in gui.$name:\n\n$err"
4209                }
4210                foreach {cn cv} [font configure $font] {
4211                        font configure ${font}bold $cn $cv
4212                }
4213                font configure ${font}bold -weight bold
4214        }
4215}
4216
4217set default_config(merge.summary) false
4218set default_config(merge.verbosity) 2
4219set default_config(gui.trustmtime) false
4220set default_config(gui.diffcontext) 5
4221set default_config(gui.newbranchtemplate) {}
4222set default_config(gui.fontui) [font configure font_ui]
4223set default_config(gui.fontdiff) [font configure font_diff]
4224set font_descs {
4225        {fontui   font_ui   {Main Font}}
4226        {fontdiff font_diff {Diff/Console Font}}
4227}
4228load_config 0
4229apply_config
4230
4231######################################################################
4232##
4233## ui construction
4234
4235# -- Menu Bar
4236#
4237menu .mbar -tearoff 0
4238.mbar add cascade -label Repository -menu .mbar.repository
4239.mbar add cascade -label Edit -menu .mbar.edit
4240if {!$single_commit} {
4241        .mbar add cascade -label Branch -menu .mbar.branch
4242}
4243.mbar add cascade -label Commit -menu .mbar.commit
4244if {!$single_commit} {
4245        .mbar add cascade -label Merge -menu .mbar.merge
4246        .mbar add cascade -label Fetch -menu .mbar.fetch
4247        .mbar add cascade -label Push -menu .mbar.push
4248}
4249. configure -menu .mbar
4250
4251# -- Repository Menu
4252#
4253menu .mbar.repository
4254.mbar.repository add command \
4255        -label {Visualize Current Branch} \
4256        -command {do_gitk {}} \
4257        -font font_ui
4258.mbar.repository add command \
4259        -label {Visualize All Branches} \
4260        -command {do_gitk {--all}} \
4261        -font font_ui
4262.mbar.repository add separator
4263
4264if {!$single_commit} {
4265        .mbar.repository add command -label {Database Statistics} \
4266                -command do_stats \
4267                -font font_ui
4268
4269        .mbar.repository add command -label {Compress Database} \
4270                -command do_gc \
4271                -font font_ui
4272
4273        .mbar.repository add command -label {Verify Database} \
4274                -command do_fsck_objects \
4275                -font font_ui
4276
4277        .mbar.repository add separator
4278
4279        if {[is_Cygwin]} {
4280                .mbar.repository add command \
4281                        -label {Create Desktop Icon} \
4282                        -command do_cygwin_shortcut \
4283                        -font font_ui
4284        } elseif {[is_Windows]} {
4285                .mbar.repository add command \
4286                        -label {Create Desktop Icon} \
4287                        -command do_windows_shortcut \
4288                        -font font_ui
4289        } elseif {[is_MacOSX]} {
4290                .mbar.repository add command \
4291                        -label {Create Desktop Icon} \
4292                        -command do_macosx_app \
4293                        -font font_ui
4294        }
4295}
4296
4297.mbar.repository add command -label Quit \
4298        -command do_quit \
4299        -accelerator $M1T-Q \
4300        -font font_ui
4301
4302# -- Edit Menu
4303#
4304menu .mbar.edit
4305.mbar.edit add command -label Undo \
4306        -command {catch {[focus] edit undo}} \
4307        -accelerator $M1T-Z \
4308        -font font_ui
4309.mbar.edit add command -label Redo \
4310        -command {catch {[focus] edit redo}} \
4311        -accelerator $M1T-Y \
4312        -font font_ui
4313.mbar.edit add separator
4314.mbar.edit add command -label Cut \
4315        -command {catch {tk_textCut [focus]}} \
4316        -accelerator $M1T-X \
4317        -font font_ui
4318.mbar.edit add command -label Copy \
4319        -command {catch {tk_textCopy [focus]}} \
4320        -accelerator $M1T-C \
4321        -font font_ui
4322.mbar.edit add command -label Paste \
4323        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4324        -accelerator $M1T-V \
4325        -font font_ui
4326.mbar.edit add command -label Delete \
4327        -command {catch {[focus] delete sel.first sel.last}} \
4328        -accelerator Del \
4329        -font font_ui
4330.mbar.edit add separator
4331.mbar.edit add command -label {Select All} \
4332        -command {catch {[focus] tag add sel 0.0 end}} \
4333        -accelerator $M1T-A \
4334        -font font_ui
4335
4336# -- Branch Menu
4337#
4338if {!$single_commit} {
4339        menu .mbar.branch
4340
4341        .mbar.branch add command -label {Create...} \
4342                -command do_create_branch \
4343                -accelerator $M1T-N \
4344                -font font_ui
4345        lappend disable_on_lock [list .mbar.branch entryconf \
4346                [.mbar.branch index last] -state]
4347
4348        .mbar.branch add command -label {Delete...} \
4349                -command do_delete_branch \
4350                -font font_ui
4351        lappend disable_on_lock [list .mbar.branch entryconf \
4352                [.mbar.branch index last] -state]
4353}
4354
4355# -- Commit Menu
4356#
4357menu .mbar.commit
4358
4359.mbar.commit add radiobutton \
4360        -label {New Commit} \
4361        -command do_select_commit_type \
4362        -variable selected_commit_type \
4363        -value new \
4364        -font font_ui
4365lappend disable_on_lock \
4366        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4367
4368.mbar.commit add radiobutton \
4369        -label {Amend Last Commit} \
4370        -command do_select_commit_type \
4371        -variable selected_commit_type \
4372        -value amend \
4373        -font font_ui
4374lappend disable_on_lock \
4375        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4376
4377.mbar.commit add separator
4378
4379.mbar.commit add command -label Rescan \
4380        -command do_rescan \
4381        -accelerator F5 \
4382        -font font_ui
4383lappend disable_on_lock \
4384        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4385
4386.mbar.commit add command -label {Add To Commit} \
4387        -command do_add_selection \
4388        -font font_ui
4389lappend disable_on_lock \
4390        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4391
4392.mbar.commit add command -label {Add All To Commit} \
4393        -command do_add_all \
4394        -accelerator $M1T-I \
4395        -font font_ui
4396lappend disable_on_lock \
4397        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4398
4399.mbar.commit add command -label {Unstage From Commit} \
4400        -command do_unstage_selection \
4401        -font font_ui
4402lappend disable_on_lock \
4403        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4404
4405.mbar.commit add command -label {Revert Changes} \
4406        -command do_revert_selection \
4407        -font font_ui
4408lappend disable_on_lock \
4409        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4410
4411.mbar.commit add separator
4412
4413.mbar.commit add command -label {Sign Off} \
4414        -command do_signoff \
4415        -accelerator $M1T-S \
4416        -font font_ui
4417
4418.mbar.commit add command -label Commit \
4419        -command do_commit \
4420        -accelerator $M1T-Return \
4421        -font font_ui
4422lappend disable_on_lock \
4423        [list .mbar.commit entryconf [.mbar.commit index last] -state]
4424
4425if {[is_MacOSX]} {
4426        # -- Apple Menu (Mac OS X only)
4427        #
4428        .mbar add cascade -label Apple -menu .mbar.apple
4429        menu .mbar.apple
4430
4431        .mbar.apple add command -label "About [appname]" \
4432                -command do_about \
4433                -font font_ui
4434        .mbar.apple add command -label "[appname] Options..." \
4435                -command do_options \
4436                -font font_ui
4437} else {
4438        # -- Edit Menu
4439        #
4440        .mbar.edit add separator
4441        .mbar.edit add command -label {Options...} \
4442                -command do_options \
4443                -font font_ui
4444
4445        # -- Tools Menu
4446        #
4447        if {[file exists /usr/local/miga/lib/gui-miga]
4448                && [file exists .pvcsrc]} {
4449        proc do_miga {} {
4450                global ui_status_value
4451                if {![lock_index update]} return
4452                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
4453                set miga_fd [open "|$cmd" r]
4454                fconfigure $miga_fd -blocking 0
4455                fileevent $miga_fd readable [list miga_done $miga_fd]
4456                set ui_status_value {Running miga...}
4457        }
4458        proc miga_done {fd} {
4459                read $fd 512
4460                if {[eof $fd]} {
4461                        close $fd
4462                        unlock_index
4463                        rescan [list set ui_status_value {Ready.}]
4464                }
4465        }
4466        .mbar add cascade -label Tools -menu .mbar.tools
4467        menu .mbar.tools
4468        .mbar.tools add command -label "Migrate" \
4469                -command do_miga \
4470                -font font_ui
4471        lappend disable_on_lock \
4472                [list .mbar.tools entryconf [.mbar.tools index last] -state]
4473        }
4474}
4475
4476# -- Help Menu
4477#
4478.mbar add cascade -label Help -menu .mbar.help
4479menu .mbar.help
4480
4481if {![is_MacOSX]} {
4482        .mbar.help add command -label "About [appname]" \
4483                -command do_about \
4484                -font font_ui
4485}
4486
4487set browser {}
4488catch {set browser $repo_config(instaweb.browser)}
4489set doc_path [file dirname [gitexec]]
4490set doc_path [file join $doc_path Documentation index.html]
4491
4492if {[is_Cygwin]} {
4493        set doc_path [exec cygpath --windows $doc_path]
4494}
4495
4496if {$browser eq {}} {
4497        if {[is_MacOSX]} {
4498                set browser open
4499        } elseif {[is_Cygwin]} {
4500                set program_files [file dirname [exec cygpath --windir]]
4501                set program_files [file join $program_files {Program Files}]
4502                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
4503                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
4504                if {[file exists $firefox]} {
4505                        set browser $firefox
4506                } elseif {[file exists $ie]} {
4507                        set browser $ie
4508                }
4509                unset program_files firefox ie
4510        }
4511}
4512
4513if {[file isfile $doc_path]} {
4514        set doc_url "file:$doc_path"
4515} else {
4516        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
4517}
4518
4519if {$browser ne {}} {
4520        .mbar.help add command -label {Online Documentation} \
4521                -command [list exec $browser $doc_url &] \
4522                -font font_ui
4523}
4524unset browser doc_path doc_url
4525
4526# -- Branch Control
4527#
4528frame .branch \
4529        -borderwidth 1 \
4530        -relief sunken
4531label .branch.l1 \
4532        -text {Current Branch:} \
4533        -anchor w \
4534        -justify left \
4535        -font font_ui
4536label .branch.cb \
4537        -textvariable current_branch \
4538        -anchor w \
4539        -justify left \
4540        -font font_ui
4541pack .branch.l1 -side left
4542pack .branch.cb -side left -fill x
4543pack .branch -side top -fill x
4544
4545if {!$single_commit} {
4546        menu .mbar.merge
4547        .mbar.merge add command -label {Local Merge...} \
4548                -command do_local_merge \
4549                -font font_ui
4550        lappend disable_on_lock \
4551                [list .mbar.merge entryconf [.mbar.merge index last] -state]
4552        .mbar.merge add command -label {Abort Merge...} \
4553                -command do_reset_hard \
4554                -font font_ui
4555        lappend disable_on_lock \
4556                [list .mbar.merge entryconf [.mbar.merge index last] -state]
4557
4558
4559        menu .mbar.fetch
4560
4561        menu .mbar.push
4562        .mbar.push add command -label {Push...} \
4563                -command do_push_anywhere \
4564                -font font_ui
4565}
4566
4567# -- Main Window Layout
4568#
4569panedwindow .vpane -orient vertical
4570panedwindow .vpane.files -orient horizontal
4571.vpane add .vpane.files -sticky nsew -height 100 -width 200
4572pack .vpane -anchor n -side top -fill both -expand 1
4573
4574# -- Index File List
4575#
4576frame .vpane.files.index -height 100 -width 200
4577label .vpane.files.index.title -text {Changes To Be Committed} \
4578        -background green \
4579        -font font_ui
4580text $ui_index -background white -borderwidth 0 \
4581        -width 20 -height 10 \
4582        -wrap none \
4583        -font font_ui \
4584        -cursor $cursor_ptr \
4585        -xscrollcommand {.vpane.files.index.sx set} \
4586        -yscrollcommand {.vpane.files.index.sy set} \
4587        -state disabled
4588scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4589scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4590pack .vpane.files.index.title -side top -fill x
4591pack .vpane.files.index.sx -side bottom -fill x
4592pack .vpane.files.index.sy -side right -fill y
4593pack $ui_index -side left -fill both -expand 1
4594.vpane.files add .vpane.files.index -sticky nsew
4595
4596# -- Working Directory File List
4597#
4598frame .vpane.files.workdir -height 100 -width 200
4599label .vpane.files.workdir.title -text {Changed But Not Updated} \
4600        -background red \
4601        -font font_ui
4602text $ui_workdir -background white -borderwidth 0 \
4603        -width 20 -height 10 \
4604        -wrap none \
4605        -font font_ui \
4606        -cursor $cursor_ptr \
4607        -xscrollcommand {.vpane.files.workdir.sx set} \
4608        -yscrollcommand {.vpane.files.workdir.sy set} \
4609        -state disabled
4610scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4611scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4612pack .vpane.files.workdir.title -side top -fill x
4613pack .vpane.files.workdir.sx -side bottom -fill x
4614pack .vpane.files.workdir.sy -side right -fill y
4615pack $ui_workdir -side left -fill both -expand 1
4616.vpane.files add .vpane.files.workdir -sticky nsew
4617
4618foreach i [list $ui_index $ui_workdir] {
4619        $i tag conf in_diff -font font_uibold
4620        $i tag conf in_sel \
4621                -background [$i cget -foreground] \
4622                -foreground [$i cget -background]
4623}
4624unset i
4625
4626# -- Diff and Commit Area
4627#
4628frame .vpane.lower -height 300 -width 400
4629frame .vpane.lower.commarea
4630frame .vpane.lower.diff -relief sunken -borderwidth 1
4631pack .vpane.lower.commarea -side top -fill x
4632pack .vpane.lower.diff -side bottom -fill both -expand 1
4633.vpane add .vpane.lower -sticky nsew
4634
4635# -- Commit Area Buttons
4636#
4637frame .vpane.lower.commarea.buttons
4638label .vpane.lower.commarea.buttons.l -text {} \
4639        -anchor w \
4640        -justify left \
4641        -font font_ui
4642pack .vpane.lower.commarea.buttons.l -side top -fill x
4643pack .vpane.lower.commarea.buttons -side left -fill y
4644
4645button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4646        -command do_rescan \
4647        -font font_ui
4648pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4649lappend disable_on_lock \
4650        {.vpane.lower.commarea.buttons.rescan conf -state}
4651
4652button .vpane.lower.commarea.buttons.incall -text {Add All} \
4653        -command do_add_all \
4654        -font font_ui
4655pack .vpane.lower.commarea.buttons.incall -side top -fill x
4656lappend disable_on_lock \
4657        {.vpane.lower.commarea.buttons.incall conf -state}
4658
4659button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4660        -command do_signoff \
4661        -font font_ui
4662pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4663
4664button .vpane.lower.commarea.buttons.commit -text {Commit} \
4665        -command do_commit \
4666        -font font_ui
4667pack .vpane.lower.commarea.buttons.commit -side top -fill x
4668lappend disable_on_lock \
4669        {.vpane.lower.commarea.buttons.commit conf -state}
4670
4671# -- Commit Message Buffer
4672#
4673frame .vpane.lower.commarea.buffer
4674frame .vpane.lower.commarea.buffer.header
4675set ui_comm .vpane.lower.commarea.buffer.t
4676set ui_coml .vpane.lower.commarea.buffer.header.l
4677radiobutton .vpane.lower.commarea.buffer.header.new \
4678        -text {New Commit} \
4679        -command do_select_commit_type \
4680        -variable selected_commit_type \
4681        -value new \
4682        -font font_ui
4683lappend disable_on_lock \
4684        [list .vpane.lower.commarea.buffer.header.new conf -state]
4685radiobutton .vpane.lower.commarea.buffer.header.amend \
4686        -text {Amend Last Commit} \
4687        -command do_select_commit_type \
4688        -variable selected_commit_type \
4689        -value amend \
4690        -font font_ui
4691lappend disable_on_lock \
4692        [list .vpane.lower.commarea.buffer.header.amend conf -state]
4693label $ui_coml \
4694        -anchor w \
4695        -justify left \
4696        -font font_ui
4697proc trace_commit_type {varname args} {
4698        global ui_coml commit_type
4699        switch -glob -- $commit_type {
4700        initial       {set txt {Initial Commit Message:}}
4701        amend         {set txt {Amended Commit Message:}}
4702        amend-initial {set txt {Amended Initial Commit Message:}}
4703        amend-merge   {set txt {Amended Merge Commit Message:}}
4704        merge         {set txt {Merge Commit Message:}}
4705        *             {set txt {Commit Message:}}
4706        }
4707        $ui_coml conf -text $txt
4708}
4709trace add variable commit_type write trace_commit_type
4710pack $ui_coml -side left -fill x
4711pack .vpane.lower.commarea.buffer.header.amend -side right
4712pack .vpane.lower.commarea.buffer.header.new -side right
4713
4714text $ui_comm -background white -borderwidth 1 \
4715        -undo true \
4716        -maxundo 20 \
4717        -autoseparators true \
4718        -relief sunken \
4719        -width 75 -height 9 -wrap none \
4720        -font font_diff \
4721        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4722scrollbar .vpane.lower.commarea.buffer.sby \
4723        -command [list $ui_comm yview]
4724pack .vpane.lower.commarea.buffer.header -side top -fill x
4725pack .vpane.lower.commarea.buffer.sby -side right -fill y
4726pack $ui_comm -side left -fill y
4727pack .vpane.lower.commarea.buffer -side left -fill y
4728
4729# -- Commit Message Buffer Context Menu
4730#
4731set ctxm .vpane.lower.commarea.buffer.ctxm
4732menu $ctxm -tearoff 0
4733$ctxm add command \
4734        -label {Cut} \
4735        -font font_ui \
4736        -command {tk_textCut $ui_comm}
4737$ctxm add command \
4738        -label {Copy} \
4739        -font font_ui \
4740        -command {tk_textCopy $ui_comm}
4741$ctxm add command \
4742        -label {Paste} \
4743        -font font_ui \
4744        -command {tk_textPaste $ui_comm}
4745$ctxm add command \
4746        -label {Delete} \
4747        -font font_ui \
4748        -command {$ui_comm delete sel.first sel.last}
4749$ctxm add separator
4750$ctxm add command \
4751        -label {Select All} \
4752        -font font_ui \
4753        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4754$ctxm add command \
4755        -label {Copy All} \
4756        -font font_ui \
4757        -command {
4758                $ui_comm tag add sel 0.0 end
4759                tk_textCopy $ui_comm
4760                $ui_comm tag remove sel 0.0 end
4761        }
4762$ctxm add separator
4763$ctxm add command \
4764        -label {Sign Off} \
4765        -font font_ui \
4766        -command do_signoff
4767bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4768
4769# -- Diff Header
4770#
4771set current_diff_path {}
4772set current_diff_side {}
4773set diff_actions [list]
4774proc trace_current_diff_path {varname args} {
4775        global current_diff_path diff_actions file_states
4776        if {$current_diff_path eq {}} {
4777                set s {}
4778                set f {}
4779                set p {}
4780                set o disabled
4781        } else {
4782                set p $current_diff_path
4783                set s [mapdesc [lindex $file_states($p) 0] $p]
4784                set f {File:}
4785                set p [escape_path $p]
4786                set o normal
4787        }
4788
4789        .vpane.lower.diff.header.status configure -text $s
4790        .vpane.lower.diff.header.file configure -text $f
4791        .vpane.lower.diff.header.path configure -text $p
4792        foreach w $diff_actions {
4793                uplevel #0 $w $o
4794        }
4795}
4796trace add variable current_diff_path write trace_current_diff_path
4797
4798frame .vpane.lower.diff.header -background orange
4799label .vpane.lower.diff.header.status \
4800        -background orange \
4801        -width $max_status_desc \
4802        -anchor w \
4803        -justify left \
4804        -font font_ui
4805label .vpane.lower.diff.header.file \
4806        -background orange \
4807        -anchor w \
4808        -justify left \
4809        -font font_ui
4810label .vpane.lower.diff.header.path \
4811        -background orange \
4812        -anchor w \
4813        -justify left \
4814        -font font_ui
4815pack .vpane.lower.diff.header.status -side left
4816pack .vpane.lower.diff.header.file -side left
4817pack .vpane.lower.diff.header.path -fill x
4818set ctxm .vpane.lower.diff.header.ctxm
4819menu $ctxm -tearoff 0
4820$ctxm add command \
4821        -label {Copy} \
4822        -font font_ui \
4823        -command {
4824                clipboard clear
4825                clipboard append \
4826                        -format STRING \
4827                        -type STRING \
4828                        -- $current_diff_path
4829        }
4830lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4831bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4832
4833# -- Diff Body
4834#
4835frame .vpane.lower.diff.body
4836set ui_diff .vpane.lower.diff.body.t
4837text $ui_diff -background white -borderwidth 0 \
4838        -width 80 -height 15 -wrap none \
4839        -font font_diff \
4840        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4841        -yscrollcommand {.vpane.lower.diff.body.sby set} \
4842        -state disabled
4843scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4844        -command [list $ui_diff xview]
4845scrollbar .vpane.lower.diff.body.sby -orient vertical \
4846        -command [list $ui_diff yview]
4847pack .vpane.lower.diff.body.sbx -side bottom -fill x
4848pack .vpane.lower.diff.body.sby -side right -fill y
4849pack $ui_diff -side left -fill both -expand 1
4850pack .vpane.lower.diff.header -side top -fill x
4851pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4852
4853$ui_diff tag conf d_cr -elide true
4854$ui_diff tag conf d_@ -foreground blue -font font_diffbold
4855$ui_diff tag conf d_+ -foreground {#00a000}
4856$ui_diff tag conf d_- -foreground red
4857
4858$ui_diff tag conf d_++ -foreground {#00a000}
4859$ui_diff tag conf d_-- -foreground red
4860$ui_diff tag conf d_+s \
4861        -foreground {#00a000} \
4862        -background {#e2effa}
4863$ui_diff tag conf d_-s \
4864        -foreground red \
4865        -background {#e2effa}
4866$ui_diff tag conf d_s+ \
4867        -foreground {#00a000} \
4868        -background ivory1
4869$ui_diff tag conf d_s- \
4870        -foreground red \
4871        -background ivory1
4872
4873$ui_diff tag conf d<<<<<<< \
4874        -foreground orange \
4875        -font font_diffbold
4876$ui_diff tag conf d======= \
4877        -foreground orange \
4878        -font font_diffbold
4879$ui_diff tag conf d>>>>>>> \
4880        -foreground orange \
4881        -font font_diffbold
4882
4883$ui_diff tag raise sel
4884
4885# -- Diff Body Context Menu
4886#
4887set ctxm .vpane.lower.diff.body.ctxm
4888menu $ctxm -tearoff 0
4889$ctxm add command \
4890        -label {Refresh} \
4891        -font font_ui \
4892        -command reshow_diff
4893lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4894$ctxm add command \
4895        -label {Copy} \
4896        -font font_ui \
4897        -command {tk_textCopy $ui_diff}
4898lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4899$ctxm add command \
4900        -label {Select All} \
4901        -font font_ui \
4902        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4903lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4904$ctxm add command \
4905        -label {Copy All} \
4906        -font font_ui \
4907        -command {
4908                $ui_diff tag add sel 0.0 end
4909                tk_textCopy $ui_diff
4910                $ui_diff tag remove sel 0.0 end
4911        }
4912lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4913$ctxm add separator
4914$ctxm add command \
4915        -label {Apply/Reverse Hunk} \
4916        -font font_ui \
4917        -command {apply_hunk $cursorX $cursorY}
4918set ui_diff_applyhunk [$ctxm index last]
4919lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4920$ctxm add separator
4921$ctxm add command \
4922        -label {Decrease Font Size} \
4923        -font font_ui \
4924        -command {incr_font_size font_diff -1}
4925lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4926$ctxm add command \
4927        -label {Increase Font Size} \
4928        -font font_ui \
4929        -command {incr_font_size font_diff 1}
4930lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4931$ctxm add separator
4932$ctxm add command \
4933        -label {Show Less Context} \
4934        -font font_ui \
4935        -command {if {$repo_config(gui.diffcontext) >= 2} {
4936                incr repo_config(gui.diffcontext) -1
4937                reshow_diff
4938        }}
4939lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4940$ctxm add command \
4941        -label {Show More Context} \
4942        -font font_ui \
4943        -command {
4944                incr repo_config(gui.diffcontext)
4945                reshow_diff
4946        }
4947lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4948$ctxm add separator
4949$ctxm add command -label {Options...} \
4950        -font font_ui \
4951        -command do_options
4952bind_button3 $ui_diff "
4953        set cursorX %x
4954        set cursorY %y
4955        if {\$ui_index eq \$current_diff_side} {
4956                $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
4957        } else {
4958                $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
4959        }
4960        tk_popup $ctxm %X %Y
4961"
4962unset ui_diff_applyhunk
4963
4964# -- Status Bar
4965#
4966set ui_status_value {Initializing...}
4967label .status -textvariable ui_status_value \
4968        -anchor w \
4969        -justify left \
4970        -borderwidth 1 \
4971        -relief sunken \
4972        -font font_ui
4973pack .status -anchor w -side bottom -fill x
4974
4975# -- Load geometry
4976#
4977catch {
4978set gm $repo_config(gui.geometry)
4979wm geometry . [lindex $gm 0]
4980.vpane sash place 0 \
4981        [lindex [.vpane sash coord 0] 0] \
4982        [lindex $gm 1]
4983.vpane.files sash place 0 \
4984        [lindex $gm 2] \
4985        [lindex [.vpane.files sash coord 0] 1]
4986unset gm
4987}
4988
4989# -- Key Bindings
4990#
4991bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4992bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4993bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4994bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4995bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4996bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4997bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4998bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4999bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5000bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5001bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5002
5003bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5004bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5005bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5006bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5007bind $ui_diff <$M1B-Key-v> {break}
5008bind $ui_diff <$M1B-Key-V> {break}
5009bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5010bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5011bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5012bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5013bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5014bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5015bind $ui_diff <Button-1>   {focus %W}
5016
5017if {!$single_commit} {
5018        bind . <$M1B-Key-n> do_create_branch
5019        bind . <$M1B-Key-N> do_create_branch
5020}
5021
5022bind .   <Destroy> do_quit
5023bind all <Key-F5> do_rescan
5024bind all <$M1B-Key-r> do_rescan
5025bind all <$M1B-Key-R> do_rescan
5026bind .   <$M1B-Key-s> do_signoff
5027bind .   <$M1B-Key-S> do_signoff
5028bind .   <$M1B-Key-i> do_add_all
5029bind .   <$M1B-Key-I> do_add_all
5030bind .   <$M1B-Key-Return> do_commit
5031bind all <$M1B-Key-q> do_quit
5032bind all <$M1B-Key-Q> do_quit
5033bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5034bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5035foreach i [list $ui_index $ui_workdir] {
5036        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5037        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5038        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5039}
5040unset i
5041
5042set file_lists($ui_index) [list]
5043set file_lists($ui_workdir) [list]
5044
5045set HEAD {}
5046set PARENT {}
5047set MERGE_HEAD [list]
5048set commit_type {}
5049set empty_tree {}
5050set current_branch {}
5051set current_diff_path {}
5052set selected_commit_type new
5053
5054wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5055focus -force $ui_comm
5056
5057# -- Warn the user about environmental problems.  Cygwin's Tcl
5058#    does *not* pass its env array onto any processes it spawns.
5059#    This means that git processes get none of our environment.
5060#
5061if {[is_Cygwin]} {
5062        set ignored_env 0
5063        set suggest_user {}
5064        set msg "Possible environment issues exist.
5065
5066The following environment variables are probably
5067going to be ignored by any Git subprocess run
5068by [appname]:
5069
5070"
5071        foreach name [array names env] {
5072                switch -regexp -- $name {
5073                {^GIT_INDEX_FILE$} -
5074                {^GIT_OBJECT_DIRECTORY$} -
5075                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5076                {^GIT_DIFF_OPTS$} -
5077                {^GIT_EXTERNAL_DIFF$} -
5078                {^GIT_PAGER$} -
5079                {^GIT_TRACE$} -
5080                {^GIT_CONFIG$} -
5081                {^GIT_CONFIG_LOCAL$} -
5082                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5083                        append msg " - $name\n"
5084                        incr ignored_env
5085                }
5086                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5087                        append msg " - $name\n"
5088                        incr ignored_env
5089                        set suggest_user $name
5090                }
5091                }
5092        }
5093        if {$ignored_env > 0} {
5094                append msg "
5095This is due to a known issue with the
5096Tcl binary distributed by Cygwin."
5097
5098                if {$suggest_user ne {}} {
5099                        append msg "
5100
5101A good replacement for $suggest_user
5102is placing values for the user.name and
5103user.email settings into your personal
5104~/.gitconfig file.
5105"
5106                }
5107                warn_popup $msg
5108        }
5109        unset ignored_env msg suggest_user name
5110}
5111
5112# -- Only initialize complex UI if we are going to stay running.
5113#
5114if {!$single_commit} {
5115        load_all_remotes
5116        load_all_heads
5117
5118        populate_branch_menu
5119        populate_fetch_menu
5120        populate_push_menu
5121}
5122
5123# -- Only suggest a gc run if we are going to stay running.
5124#
5125if {!$single_commit} {
5126        set object_limit 2000
5127        if {[is_Windows]} {set object_limit 200}
5128        regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5129        if {$objects_current >= $object_limit} {
5130                if {[ask_popup \
5131                        "This repository currently has $objects_current loose objects.
5132
5133To maintain optimal performance it is strongly
5134recommended that you compress the database
5135when more than $object_limit loose objects exist.
5136
5137Compress the database now?"] eq yes} {
5138                        do_gc
5139                }
5140        }
5141        unset object_limit _junk objects_current
5142}
5143
5144lock_index begin-read
5145after 1 do_rescan