13cd1b9b4a2d376c308f19565e0a91b1bf5bd3cb
   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 _reponame {}
  30
  31proc appname {} {
  32        global _appname
  33        return $_appname
  34}
  35
  36proc gitdir {args} {
  37        global _gitdir
  38        if {$args eq {}} {
  39                return $_gitdir
  40        }
  41        return [eval [concat [list file join $_gitdir] $args]]
  42}
  43
  44proc reponame {} {
  45        global _reponame
  46        return $_reponame
  47}
  48
  49######################################################################
  50##
  51## config
  52
  53proc is_many_config {name} {
  54        switch -glob -- $name {
  55        remote.*.fetch -
  56        remote.*.push
  57                {return 1}
  58        *
  59                {return 0}
  60        }
  61}
  62
  63proc load_config {include_global} {
  64        global repo_config global_config default_config
  65
  66        array unset global_config
  67        if {$include_global} {
  68                catch {
  69                        set fd_rc [open "| git repo-config --global --list" r]
  70                        while {[gets $fd_rc line] >= 0} {
  71                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  72                                        if {[is_many_config $name]} {
  73                                                lappend global_config($name) $value
  74                                        } else {
  75                                                set global_config($name) $value
  76                                        }
  77                                }
  78                        }
  79                        close $fd_rc
  80                }
  81        }
  82
  83        array unset repo_config
  84        catch {
  85                set fd_rc [open "| git repo-config --list" r]
  86                while {[gets $fd_rc line] >= 0} {
  87                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  88                                if {[is_many_config $name]} {
  89                                        lappend repo_config($name) $value
  90                                } else {
  91                                        set repo_config($name) $value
  92                                }
  93                        }
  94                }
  95                close $fd_rc
  96        }
  97
  98        foreach name [array names default_config] {
  99                if {[catch {set v $global_config($name)}]} {
 100                        set global_config($name) $default_config($name)
 101                }
 102                if {[catch {set v $repo_config($name)}]} {
 103                        set repo_config($name) $default_config($name)
 104                }
 105        }
 106}
 107
 108proc save_config {} {
 109        global default_config font_descs
 110        global repo_config global_config
 111        global repo_config_new global_config_new
 112
 113        foreach option $font_descs {
 114                set name [lindex $option 0]
 115                set font [lindex $option 1]
 116                font configure $font \
 117                        -family $global_config_new(gui.$font^^family) \
 118                        -size $global_config_new(gui.$font^^size)
 119                font configure ${font}bold \
 120                        -family $global_config_new(gui.$font^^family) \
 121                        -size $global_config_new(gui.$font^^size)
 122                set global_config_new(gui.$name) [font configure $font]
 123                unset global_config_new(gui.$font^^family)
 124                unset global_config_new(gui.$font^^size)
 125        }
 126
 127        foreach name [array names default_config] {
 128                set value $global_config_new($name)
 129                if {$value ne $global_config($name)} {
 130                        if {$value eq $default_config($name)} {
 131                                catch {exec git repo-config --global --unset $name}
 132                        } else {
 133                                regsub -all "\[{}\]" $value {"} value
 134                                exec git repo-config --global $name $value
 135                        }
 136                        set global_config($name) $value
 137                        if {$value eq $repo_config($name)} {
 138                                catch {exec git repo-config --unset $name}
 139                                set repo_config($name) $value
 140                        }
 141                }
 142        }
 143
 144        foreach name [array names default_config] {
 145                set value $repo_config_new($name)
 146                if {$value ne $repo_config($name)} {
 147                        if {$value eq $global_config($name)} {
 148                                catch {exec git repo-config --unset $name}
 149                        } else {
 150                                regsub -all "\[{}\]" $value {"} value
 151                                exec git repo-config $name $value
 152                        }
 153                        set repo_config($name) $value
 154                }
 155        }
 156}
 157
 158proc error_popup {msg} {
 159        set title [appname]
 160        if {[reponame] ne {}} {
 161                append title " ([reponame])"
 162        }
 163        set cmd [list tk_messageBox \
 164                -icon error \
 165                -type ok \
 166                -title "$title: error" \
 167                -message $msg]
 168        if {[winfo ismapped .]} {
 169                lappend cmd -parent .
 170        }
 171        eval $cmd
 172}
 173
 174proc warn_popup {msg} {
 175        set title [appname]
 176        if {[reponame] ne {}} {
 177                append title " ([reponame])"
 178        }
 179        set cmd [list tk_messageBox \
 180                -icon warning \
 181                -type ok \
 182                -title "$title: warning" \
 183                -message $msg]
 184        if {[winfo ismapped .]} {
 185                lappend cmd -parent .
 186        }
 187        eval $cmd
 188}
 189
 190proc info_popup {msg} {
 191        set title [appname]
 192        if {[reponame] ne {}} {
 193                append title " ([reponame])"
 194        }
 195        tk_messageBox \
 196                -parent . \
 197                -icon info \
 198                -type ok \
 199                -title $title \
 200                -message $msg
 201}
 202
 203proc ask_popup {msg} {
 204        set title [appname]
 205        if {[reponame] ne {}} {
 206                append title " ([reponame])"
 207        }
 208        return [tk_messageBox \
 209                -parent . \
 210                -icon question \
 211                -type yesno \
 212                -title $title \
 213                -message $msg]
 214}
 215
 216######################################################################
 217##
 218## repository setup
 219
 220if {   [catch {set _gitdir $env(GIT_DIR)}]
 221        && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 222        catch {wm withdraw .}
 223        error_popup "Cannot find the git directory:\n\n$err"
 224        exit 1
 225}
 226if {![file isdirectory $_gitdir]} {
 227        catch {wm withdraw .}
 228        error_popup "Git directory not found:\n\n$_gitdir"
 229        exit 1
 230}
 231if {[lindex [file split $_gitdir] end] ne {.git}} {
 232        catch {wm withdraw .}
 233        error_popup "Cannot use funny .git directory:\n\n$gitdir"
 234        exit 1
 235}
 236if {[catch {cd [file dirname $_gitdir]} err]} {
 237        catch {wm withdraw .}
 238        error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 239        exit 1
 240}
 241set _reponame [lindex [file split \
 242        [file normalize [file dirname $_gitdir]]] \
 243        end]
 244
 245set single_commit 0
 246if {[appname] eq {git-citool}} {
 247        set single_commit 1
 248}
 249
 250######################################################################
 251##
 252## task management
 253
 254set rescan_active 0
 255set diff_active 0
 256set last_clicked {}
 257
 258set disable_on_lock [list]
 259set index_lock_type none
 260
 261proc lock_index {type} {
 262        global index_lock_type disable_on_lock
 263
 264        if {$index_lock_type eq {none}} {
 265                set index_lock_type $type
 266                foreach w $disable_on_lock {
 267                        uplevel #0 $w disabled
 268                }
 269                return 1
 270        } elseif {$index_lock_type eq "begin-$type"} {
 271                set index_lock_type $type
 272                return 1
 273        }
 274        return 0
 275}
 276
 277proc unlock_index {} {
 278        global index_lock_type disable_on_lock
 279
 280        set index_lock_type none
 281        foreach w $disable_on_lock {
 282                uplevel #0 $w normal
 283        }
 284}
 285
 286######################################################################
 287##
 288## status
 289
 290proc repository_state {ctvar hdvar mhvar} {
 291        global current_branch
 292        upvar $ctvar ct $hdvar hd $mhvar mh
 293
 294        set mh [list]
 295
 296        if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 297                set current_branch {}
 298        } else {
 299                regsub ^refs/((heads|tags|remotes)/)? \
 300                        $current_branch \
 301                        {} \
 302                        current_branch
 303        }
 304
 305        if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 306                set hd {}
 307                set ct initial
 308                return
 309        }
 310
 311        set merge_head [gitdir MERGE_HEAD]
 312        if {[file exists $merge_head]} {
 313                set ct merge
 314                set fd_mh [open $merge_head r]
 315                while {[gets $fd_mh line] >= 0} {
 316                        lappend mh $line
 317                }
 318                close $fd_mh
 319                return
 320        }
 321
 322        set ct normal
 323}
 324
 325proc PARENT {} {
 326        global PARENT empty_tree
 327
 328        set p [lindex $PARENT 0]
 329        if {$p ne {}} {
 330                return $p
 331        }
 332        if {$empty_tree eq {}} {
 333                set empty_tree [exec git mktree << {}]
 334        }
 335        return $empty_tree
 336}
 337
 338proc rescan {after} {
 339        global HEAD PARENT MERGE_HEAD commit_type
 340        global ui_index ui_workdir ui_status_value ui_comm
 341        global rescan_active file_states
 342        global repo_config
 343
 344        if {$rescan_active > 0 || ![lock_index read]} return
 345
 346        repository_state newType newHEAD newMERGE_HEAD
 347        if {[string match amend* $commit_type]
 348                && $newType eq {normal}
 349                && $newHEAD eq $HEAD} {
 350        } else {
 351                set HEAD $newHEAD
 352                set PARENT $newHEAD
 353                set MERGE_HEAD $newMERGE_HEAD
 354                set commit_type $newType
 355        }
 356
 357        array unset file_states
 358
 359        if {![$ui_comm edit modified]
 360                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 361                if {[load_message GITGUI_MSG]} {
 362                } elseif {[load_message MERGE_MSG]} {
 363                } elseif {[load_message SQUASH_MSG]} {
 364                }
 365                $ui_comm edit reset
 366                $ui_comm edit modified false
 367        }
 368
 369        if {$repo_config(gui.trustmtime) eq {true}} {
 370                rescan_stage2 {} $after
 371        } else {
 372                set rescan_active 1
 373                set ui_status_value {Refreshing file status...}
 374                set cmd [list git update-index]
 375                lappend cmd -q
 376                lappend cmd --unmerged
 377                lappend cmd --ignore-missing
 378                lappend cmd --refresh
 379                set fd_rf [open "| $cmd" r]
 380                fconfigure $fd_rf -blocking 0 -translation binary
 381                fileevent $fd_rf readable \
 382                        [list rescan_stage2 $fd_rf $after]
 383        }
 384}
 385
 386proc rescan_stage2 {fd after} {
 387        global ui_status_value
 388        global rescan_active buf_rdi buf_rdf buf_rlo
 389
 390        if {$fd ne {}} {
 391                read $fd
 392                if {![eof $fd]} return
 393                close $fd
 394        }
 395
 396        set ls_others [list | git ls-files --others -z \
 397                --exclude-per-directory=.gitignore]
 398        set info_exclude [gitdir info exclude]
 399        if {[file readable $info_exclude]} {
 400                lappend ls_others "--exclude-from=$info_exclude"
 401        }
 402
 403        set buf_rdi {}
 404        set buf_rdf {}
 405        set buf_rlo {}
 406
 407        set rescan_active 3
 408        set ui_status_value {Scanning for modified files ...}
 409        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 410        set fd_df [open "| git diff-files -z" r]
 411        set fd_lo [open $ls_others r]
 412
 413        fconfigure $fd_di -blocking 0 -translation binary
 414        fconfigure $fd_df -blocking 0 -translation binary
 415        fconfigure $fd_lo -blocking 0 -translation binary
 416        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 417        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 418        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 419}
 420
 421proc load_message {file} {
 422        global ui_comm
 423
 424        set f [gitdir $file]
 425        if {[file isfile $f]} {
 426                if {[catch {set fd [open $f r]}]} {
 427                        return 0
 428                }
 429                set content [string trim [read $fd]]
 430                close $fd
 431                $ui_comm delete 0.0 end
 432                $ui_comm insert end $content
 433                return 1
 434        }
 435        return 0
 436}
 437
 438proc read_diff_index {fd after} {
 439        global buf_rdi
 440
 441        append buf_rdi [read $fd]
 442        set c 0
 443        set n [string length $buf_rdi]
 444        while {$c < $n} {
 445                set z1 [string first "\0" $buf_rdi $c]
 446                if {$z1 == -1} break
 447                incr z1
 448                set z2 [string first "\0" $buf_rdi $z1]
 449                if {$z2 == -1} break
 450
 451                incr c
 452                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 453                merge_state \
 454                        [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 455                        [lindex $i 4]? \
 456                        [list [lindex $i 0] [lindex $i 2]] \
 457                        [list]
 458                set c $z2
 459                incr c
 460        }
 461        if {$c < $n} {
 462                set buf_rdi [string range $buf_rdi $c end]
 463        } else {
 464                set buf_rdi {}
 465        }
 466
 467        rescan_done $fd buf_rdi $after
 468}
 469
 470proc read_diff_files {fd after} {
 471        global buf_rdf
 472
 473        append buf_rdf [read $fd]
 474        set c 0
 475        set n [string length $buf_rdf]
 476        while {$c < $n} {
 477                set z1 [string first "\0" $buf_rdf $c]
 478                if {$z1 == -1} break
 479                incr z1
 480                set z2 [string first "\0" $buf_rdf $z1]
 481                if {$z2 == -1} break
 482
 483                incr c
 484                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 485                merge_state \
 486                        [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 487                        ?[lindex $i 4] \
 488                        [list] \
 489                        [list [lindex $i 0] [lindex $i 2]]
 490                set c $z2
 491                incr c
 492        }
 493        if {$c < $n} {
 494                set buf_rdf [string range $buf_rdf $c end]
 495        } else {
 496                set buf_rdf {}
 497        }
 498
 499        rescan_done $fd buf_rdf $after
 500}
 501
 502proc read_ls_others {fd after} {
 503        global buf_rlo
 504
 505        append buf_rlo [read $fd]
 506        set pck [split $buf_rlo "\0"]
 507        set buf_rlo [lindex $pck end]
 508        foreach p [lrange $pck 0 end-1] {
 509                merge_state $p ?O
 510        }
 511        rescan_done $fd buf_rlo $after
 512}
 513
 514proc rescan_done {fd buf after} {
 515        global rescan_active
 516        global file_states repo_config
 517        upvar $buf to_clear
 518
 519        if {![eof $fd]} return
 520        set to_clear {}
 521        close $fd
 522        if {[incr rescan_active -1] > 0} return
 523
 524        prune_selection
 525        unlock_index
 526        display_all_files
 527
 528        if {$repo_config(gui.partialinclude) ne {true}} {
 529                set pathList [list]
 530                foreach path [array names file_states] {
 531                        switch -- [lindex $file_states($path) 0] {
 532                        A? -
 533                        M? {lappend pathList $path}
 534                        }
 535                }
 536                if {$pathList ne {}} {
 537                        update_index \
 538                                "Updating included files" \
 539                                $pathList \
 540                                [concat {reshow_diff;} $after]
 541                        return
 542                }
 543        }
 544
 545        reshow_diff
 546        uplevel #0 $after
 547}
 548
 549proc prune_selection {} {
 550        global file_states selected_paths
 551
 552        foreach path [array names selected_paths] {
 553                if {[catch {set still_here $file_states($path)}]} {
 554                        unset selected_paths($path)
 555                }
 556        }
 557}
 558
 559######################################################################
 560##
 561## diff
 562
 563proc clear_diff {} {
 564        global ui_diff current_diff ui_index ui_workdir
 565
 566        $ui_diff conf -state normal
 567        $ui_diff delete 0.0 end
 568        $ui_diff conf -state disabled
 569
 570        set current_diff {}
 571
 572        $ui_index tag remove in_diff 0.0 end
 573        $ui_workdir tag remove in_diff 0.0 end
 574}
 575
 576proc reshow_diff {} {
 577        global current_diff ui_status_value file_states
 578
 579        if {$current_diff eq {}
 580                || [catch {set s $file_states($current_diff)}]} {
 581                clear_diff
 582        } else {
 583                show_diff $current_diff
 584        }
 585}
 586
 587proc handle_empty_diff {} {
 588        global current_diff file_states file_lists
 589
 590        set path $current_diff
 591        set s $file_states($path)
 592        if {[lindex $s 0] ne {_M}} return
 593
 594        info_popup "No differences detected.
 595
 596[short_path $path] has no changes.
 597
 598The modification date of this file was updated
 599by another application and you currently have
 600the Trust File Modification Timestamps option
 601enabled, so Git did not automatically detect
 602that there are no content differences in this
 603file.
 604
 605This file will now be removed from the modified
 606files list, to prevent possible confusion.
 607"
 608        if {[catch {exec git update-index -- $path} err]} {
 609                error_popup "Failed to refresh index:\n\n$err"
 610        }
 611
 612        clear_diff
 613        display_file $path __
 614}
 615
 616proc show_diff {path {w {}} {lno {}}} {
 617        global file_states file_lists
 618        global is_3way_diff diff_active repo_config
 619        global ui_diff current_diff ui_status_value
 620
 621        if {$diff_active || ![lock_index read]} return
 622
 623        clear_diff
 624        if {$w eq {} || $lno == {}} {
 625                foreach w [array names file_lists] {
 626                        set lno [lsearch -sorted $file_lists($w) $path]
 627                        if {$lno >= 0} {
 628                                incr lno
 629                                break
 630                        }
 631                }
 632        }
 633        if {$w ne {} && $lno >= 1} {
 634                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 635        }
 636
 637        set s $file_states($path)
 638        set m [lindex $s 0]
 639        set is_3way_diff 0
 640        set diff_active 1
 641        set current_diff $path
 642        set ui_status_value "Loading diff of [escape_path $path]..."
 643
 644        set cmd [list | git diff-index]
 645        lappend cmd --no-color
 646        if {$repo_config(gui.diffcontext) > 0} {
 647                lappend cmd "-U$repo_config(gui.diffcontext)"
 648        }
 649        lappend cmd -p
 650
 651        switch $m {
 652        MM {
 653                lappend cmd -c
 654        }
 655        _O {
 656                if {[catch {
 657                                set fd [open $path r]
 658                                set content [read $fd]
 659                                close $fd
 660                        } err ]} {
 661                        set diff_active 0
 662                        unlock_index
 663                        set ui_status_value "Unable to display [escape_path $path]"
 664                        error_popup "Error loading file:\n\n$err"
 665                        return
 666                }
 667                $ui_diff conf -state normal
 668                $ui_diff insert end $content
 669                $ui_diff conf -state disabled
 670                set diff_active 0
 671                unlock_index
 672                set ui_status_value {Ready.}
 673                return
 674        }
 675        }
 676
 677        lappend cmd [PARENT]
 678        lappend cmd --
 679        lappend cmd $path
 680
 681        if {[catch {set fd [open $cmd r]} err]} {
 682                set diff_active 0
 683                unlock_index
 684                set ui_status_value "Unable to display [escape_path $path]"
 685                error_popup "Error loading diff:\n\n$err"
 686                return
 687        }
 688
 689        fconfigure $fd -blocking 0 -translation auto
 690        fileevent $fd readable [list read_diff $fd]
 691}
 692
 693proc read_diff {fd} {
 694        global ui_diff ui_status_value is_3way_diff diff_active
 695        global repo_config
 696
 697        $ui_diff conf -state normal
 698        while {[gets $fd line] >= 0} {
 699                # -- Cleanup uninteresting diff header lines.
 700                #
 701                if {[string match {diff --git *}      $line]} continue
 702                if {[string match {diff --combined *} $line]} continue
 703                if {[string match {--- *}             $line]} continue
 704                if {[string match {+++ *}             $line]} continue
 705                if {$line eq {deleted file mode 120000}} {
 706                        set line "deleted symlink"
 707                }
 708
 709                # -- Automatically detect if this is a 3 way diff.
 710                #
 711                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 712
 713                # -- Reformat a 3 way diff, 'cause its too weird.
 714                #
 715                if {$is_3way_diff} {
 716                        set op [string range $line 0 1]
 717                        switch -- $op {
 718                        {@@} {set tags d_@}
 719                        {++} {set tags d_+ ; set op { +}}
 720                        {--} {set tags d_- ; set op { -}}
 721                        { +} {set tags d_++; set op {++}}
 722                        { -} {set tags d_--; set op {--}}
 723                        {+ } {set tags d_-+; set op {-+}}
 724                        {- } {set tags d_+-; set op {+-}}
 725                        default {set tags {}}
 726                        }
 727                        set line [string replace $line 0 1 $op]
 728                } else {
 729                        switch -- [string index $line 0] {
 730                        @ {set tags d_@}
 731                        + {set tags d_+}
 732                        - {set tags d_-}
 733                        default {set tags {}}
 734                        }
 735                }
 736                $ui_diff insert end $line $tags
 737                $ui_diff insert end "\n" $tags
 738        }
 739        $ui_diff conf -state disabled
 740
 741        if {[eof $fd]} {
 742                close $fd
 743                set diff_active 0
 744                unlock_index
 745                set ui_status_value {Ready.}
 746
 747                if {$repo_config(gui.trustmtime) eq {true}
 748                        && [$ui_diff index end] eq {2.0}} {
 749                        handle_empty_diff
 750                }
 751        }
 752}
 753
 754######################################################################
 755##
 756## commit
 757
 758proc load_last_commit {} {
 759        global HEAD PARENT MERGE_HEAD commit_type ui_comm
 760
 761        if {[llength $PARENT] == 0} {
 762                error_popup {There is nothing to amend.
 763
 764You are about to create the initial commit.
 765There is no commit before this to amend.
 766}
 767                return
 768        }
 769
 770        repository_state curType curHEAD curMERGE_HEAD
 771        if {$curType eq {merge}} {
 772                error_popup {Cannot amend while merging.
 773
 774You are currently in the middle of a merge that
 775has not been fully completed.  You cannot amend
 776the prior commit unless you first abort the
 777current merge activity.
 778}
 779                return
 780        }
 781
 782        set msg {}
 783        set parents [list]
 784        if {[catch {
 785                        set fd [open "| git cat-file commit $curHEAD" r]
 786                        while {[gets $fd line] > 0} {
 787                                if {[string match {parent *} $line]} {
 788                                        lappend parents [string range $line 7 end]
 789                                }
 790                        }
 791                        set msg [string trim [read $fd]]
 792                        close $fd
 793                } err]} {
 794                error_popup "Error loading commit data for amend:\n\n$err"
 795                return
 796        }
 797
 798        set HEAD $curHEAD
 799        set PARENT $parents
 800        set MERGE_HEAD [list]
 801        switch -- [llength $parents] {
 802        0       {set commit_type amend-initial}
 803        1       {set commit_type amend}
 804        default {set commit_type amend-merge}
 805        }
 806
 807        $ui_comm delete 0.0 end
 808        $ui_comm insert end $msg
 809        $ui_comm edit reset
 810        $ui_comm edit modified false
 811        rescan {set ui_status_value {Ready.}}
 812}
 813
 814proc create_new_commit {} {
 815        global commit_type ui_comm
 816
 817        set commit_type normal
 818        $ui_comm delete 0.0 end
 819        $ui_comm edit reset
 820        $ui_comm edit modified false
 821        rescan {set ui_status_value {Ready.}}
 822}
 823
 824set GIT_COMMITTER_IDENT {}
 825
 826proc committer_ident {} {
 827        global GIT_COMMITTER_IDENT
 828
 829        if {$GIT_COMMITTER_IDENT eq {}} {
 830                if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 831                        error_popup "Unable to obtain your identity:\n\n$err"
 832                        return {}
 833                }
 834                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 835                        $me me GIT_COMMITTER_IDENT]} {
 836                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 837                        return {}
 838                }
 839        }
 840
 841        return $GIT_COMMITTER_IDENT
 842}
 843
 844proc commit_tree {} {
 845        global HEAD commit_type file_states ui_comm repo_config
 846
 847        if {![lock_index update]} return
 848        if {[committer_ident] eq {}} return
 849
 850        # -- Our in memory state should match the repository.
 851        #
 852        repository_state curType curHEAD curMERGE_HEAD
 853        if {[string match amend* $commit_type]
 854                && $curType eq {normal}
 855                && $curHEAD eq $HEAD} {
 856        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 857                info_popup {Last scanned state does not match repository state.
 858
 859Another Git program has modified this repository
 860since the last scan.  A rescan must be performed
 861before another commit can be created.
 862
 863The rescan will be automatically started now.
 864}
 865                unlock_index
 866                rescan {set ui_status_value {Ready.}}
 867                return
 868        }
 869
 870        # -- At least one file should differ in the index.
 871        #
 872        set files_ready 0
 873        foreach path [array names file_states] {
 874                switch -glob -- [lindex $file_states($path) 0] {
 875                _? {continue}
 876                A? -
 877                D? -
 878                M? {set files_ready 1; break}
 879                U? {
 880                        error_popup "Unmerged files cannot be committed.
 881
 882File [short_path $path] has merge conflicts.
 883You must resolve them and include the file before committing.
 884"
 885                        unlock_index
 886                        return
 887                }
 888                default {
 889                        error_popup "Unknown file state [lindex $s 0] detected.
 890
 891File [short_path $path] cannot be committed by this program.
 892"
 893                }
 894                }
 895        }
 896        if {!$files_ready} {
 897                error_popup {No included files to commit.
 898
 899You must include at least 1 file before you can commit.
 900}
 901                unlock_index
 902                return
 903        }
 904
 905        # -- A message is required.
 906        #
 907        set msg [string trim [$ui_comm get 1.0 end]]
 908        if {$msg eq {}} {
 909                error_popup {Please supply a commit message.
 910
 911A good commit message has the following format:
 912
 913- First line: Describe in one sentance what you did.
 914- Second line: Blank
 915- Remaining lines: Describe why this change is good.
 916}
 917                unlock_index
 918                return
 919        }
 920
 921        # -- Update included files if partialincludes are off.
 922        #
 923        if {$repo_config(gui.partialinclude) ne {true}} {
 924                set pathList [list]
 925                foreach path [array names file_states] {
 926                        switch -glob -- [lindex $file_states($path) 0] {
 927                        A? -
 928                        M? {lappend pathList $path}
 929                        }
 930                }
 931                if {$pathList ne {}} {
 932                        unlock_index
 933                        update_index \
 934                                "Updating included files" \
 935                                $pathList \
 936                                [concat {lock_index update;} \
 937                                        [list commit_prehook $curHEAD $msg]]
 938                        return
 939                }
 940        }
 941
 942        commit_prehook $curHEAD $msg
 943}
 944
 945proc commit_prehook {curHEAD msg} {
 946        global ui_status_value pch_error
 947
 948        set pchook [gitdir hooks pre-commit]
 949
 950        # On Cygwin [file executable] might lie so we need to ask
 951        # the shell if the hook is executable.  Yes that's annoying.
 952        #
 953        if {[is_Windows] && [file isfile $pchook]} {
 954                set pchook [list sh -c [concat \
 955                        "if test -x \"$pchook\";" \
 956                        "then exec \"$pchook\" 2>&1;" \
 957                        "fi"]]
 958        } elseif {[file executable $pchook]} {
 959                set pchook [list $pchook |& cat]
 960        } else {
 961                commit_writetree $curHEAD $msg
 962                return
 963        }
 964
 965        set ui_status_value {Calling pre-commit hook...}
 966        set pch_error {}
 967        set fd_ph [open "| $pchook" r]
 968        fconfigure $fd_ph -blocking 0 -translation binary
 969        fileevent $fd_ph readable \
 970                [list commit_prehook_wait $fd_ph $curHEAD $msg]
 971}
 972
 973proc commit_prehook_wait {fd_ph curHEAD msg} {
 974        global pch_error ui_status_value
 975
 976        append pch_error [read $fd_ph]
 977        fconfigure $fd_ph -blocking 1
 978        if {[eof $fd_ph]} {
 979                if {[catch {close $fd_ph}]} {
 980                        set ui_status_value {Commit declined by pre-commit hook.}
 981                        hook_failed_popup pre-commit $pch_error
 982                        unlock_index
 983                } else {
 984                        commit_writetree $curHEAD $msg
 985                }
 986                set pch_error {}
 987                return
 988        }
 989        fconfigure $fd_ph -blocking 0
 990}
 991
 992proc commit_writetree {curHEAD msg} {
 993        global ui_status_value
 994
 995        set ui_status_value {Committing changes...}
 996        set fd_wt [open "| git write-tree" r]
 997        fileevent $fd_wt readable \
 998                [list commit_committree $fd_wt $curHEAD $msg]
 999}
1000
1001proc commit_committree {fd_wt curHEAD msg} {
1002        global HEAD PARENT MERGE_HEAD commit_type
1003        global single_commit
1004        global ui_status_value ui_comm selected_commit_type
1005        global file_states selected_paths rescan_active
1006
1007        gets $fd_wt tree_id
1008        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1009                error_popup "write-tree failed:\n\n$err"
1010                set ui_status_value {Commit failed.}
1011                unlock_index
1012                return
1013        }
1014
1015        # -- Create the commit.
1016        #
1017        set cmd [list git commit-tree $tree_id]
1018        set parents [concat $PARENT $MERGE_HEAD]
1019        if {[llength $parents] > 0} {
1020                foreach p $parents {
1021                        lappend cmd -p $p
1022                }
1023        } else {
1024                # git commit-tree writes to stderr during initial commit.
1025                lappend cmd 2>/dev/null
1026        }
1027        lappend cmd << $msg
1028        if {[catch {set cmt_id [eval exec $cmd]} err]} {
1029                error_popup "commit-tree failed:\n\n$err"
1030                set ui_status_value {Commit failed.}
1031                unlock_index
1032                return
1033        }
1034
1035        # -- Update the HEAD ref.
1036        #
1037        set reflogm commit
1038        if {$commit_type ne {normal}} {
1039                append reflogm " ($commit_type)"
1040        }
1041        set i [string first "\n" $msg]
1042        if {$i >= 0} {
1043                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1044        } else {
1045                append reflogm {: } $msg
1046        }
1047        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1048        if {[catch {eval exec $cmd} err]} {
1049                error_popup "update-ref failed:\n\n$err"
1050                set ui_status_value {Commit failed.}
1051                unlock_index
1052                return
1053        }
1054
1055        # -- Cleanup after ourselves.
1056        #
1057        catch {file delete [gitdir MERGE_HEAD]}
1058        catch {file delete [gitdir MERGE_MSG]}
1059        catch {file delete [gitdir SQUASH_MSG]}
1060        catch {file delete [gitdir GITGUI_MSG]}
1061
1062        # -- Let rerere do its thing.
1063        #
1064        if {[file isdirectory [gitdir rr-cache]]} {
1065                catch {exec git rerere}
1066        }
1067
1068        # -- Run the post-commit hook.
1069        #
1070        set pchook [gitdir hooks post-commit]
1071        if {[is_Windows] && [file isfile $pchook]} {
1072                set pchook [list sh -c [concat \
1073                        "if test -x \"$pchook\";" \
1074                        "then exec \"$pchook\";" \
1075                        "fi"]]
1076        } elseif {![file executable $pchook]} {
1077                set pchook {}
1078        }
1079        if {$pchook ne {}} {
1080                catch {exec $pchook &}
1081        }
1082
1083        $ui_comm delete 0.0 end
1084        $ui_comm edit reset
1085        $ui_comm edit modified false
1086
1087        if {$single_commit} do_quit
1088
1089        # -- Update in memory status
1090        #
1091        set selected_commit_type new
1092        set commit_type normal
1093        set HEAD $cmt_id
1094        set PARENT $cmt_id
1095        set MERGE_HEAD [list]
1096
1097        foreach path [array names file_states] {
1098                set s $file_states($path)
1099                set m [lindex $s 0]
1100                switch -glob -- $m {
1101                _O -
1102                _M -
1103                _D {continue}
1104                __ -
1105                A_ -
1106                M_ -
1107                D_ {
1108                        unset file_states($path)
1109                        catch {unset selected_paths($path)}
1110                }
1111                DO {
1112                        set file_states($path) [list _O [lindex $s 1] {} {}]
1113                }
1114                AM -
1115                AD -
1116                MM -
1117                MD {
1118                        set file_states($path) [list \
1119                                _[string index $m 1] \
1120                                [lindex $s 1] \
1121                                [lindex $s 3] \
1122                                {}]
1123                }
1124                }
1125        }
1126
1127        display_all_files
1128        unlock_index
1129        reshow_diff
1130        set ui_status_value \
1131                "Changes committed as [string range $cmt_id 0 7]."
1132}
1133
1134######################################################################
1135##
1136## fetch pull push
1137
1138proc fetch_from {remote} {
1139        set w [new_console "fetch $remote" \
1140                "Fetching new changes from $remote"]
1141        set cmd [list git fetch]
1142        lappend cmd $remote
1143        console_exec $w $cmd
1144}
1145
1146proc pull_remote {remote branch} {
1147        global HEAD commit_type file_states repo_config
1148
1149        if {![lock_index update]} return
1150
1151        # -- Our in memory state should match the repository.
1152        #
1153        repository_state curType curHEAD curMERGE_HEAD
1154        if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1155                info_popup {Last scanned state does not match repository state.
1156
1157Another Git program has modified this repository
1158since the last scan.  A rescan must be performed
1159before a pull operation can be started.
1160
1161The rescan will be automatically started now.
1162}
1163                unlock_index
1164                rescan {set ui_status_value {Ready.}}
1165                return
1166        }
1167
1168        # -- No differences should exist before a pull.
1169        #
1170        if {[array size file_states] != 0} {
1171                error_popup {Uncommitted but modified files are present.
1172
1173You should not perform a pull with unmodified
1174files in your working directory as Git will be
1175unable to recover from an incorrect merge.
1176
1177You should commit or revert all changes before
1178starting a pull operation.
1179}
1180                unlock_index
1181                return
1182        }
1183
1184        set w [new_console "pull $remote $branch" \
1185                "Pulling new changes from branch $branch in $remote"]
1186        set cmd [list git pull]
1187        if {$repo_config(gui.pullsummary) eq {false}} {
1188                lappend cmd --no-summary
1189        }
1190        lappend cmd $remote
1191        lappend cmd $branch
1192        console_exec $w $cmd [list post_pull_remote $remote $branch]
1193}
1194
1195proc post_pull_remote {remote branch success} {
1196        global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1197        global ui_status_value
1198
1199        unlock_index
1200        if {$success} {
1201                repository_state commit_type HEAD MERGE_HEAD
1202                set PARENT $HEAD
1203                set selected_commit_type new
1204                set ui_status_value "Pulling $branch from $remote complete."
1205        } else {
1206                rescan [list set ui_status_value \
1207                        "Conflicts detected while pulling $branch from $remote."]
1208        }
1209}
1210
1211proc push_to {remote} {
1212        set w [new_console "push $remote" \
1213                "Pushing changes to $remote"]
1214        set cmd [list git push]
1215        lappend cmd $remote
1216        console_exec $w $cmd
1217}
1218
1219######################################################################
1220##
1221## ui helpers
1222
1223proc mapicon {w state path} {
1224        global all_icons
1225
1226        if {[catch {set r $all_icons($state$w)}]} {
1227                puts "error: no icon for $w state={$state} $path"
1228                return file_plain
1229        }
1230        return $r
1231}
1232
1233proc mapdesc {state path} {
1234        global all_descs
1235
1236        if {[catch {set r $all_descs($state)}]} {
1237                puts "error: no desc for state={$state} $path"
1238                return $state
1239        }
1240        return $r
1241}
1242
1243proc escape_path {path} {
1244        regsub -all "\n" $path "\\n" path
1245        return $path
1246}
1247
1248proc short_path {path} {
1249        return [escape_path [lindex [file split $path] end]]
1250}
1251
1252set next_icon_id 0
1253set null_sha1 [string repeat 0 40]
1254
1255proc merge_state {path new_state {head_info {}} {index_info {}}} {
1256        global file_states next_icon_id null_sha1
1257
1258        set s0 [string index $new_state 0]
1259        set s1 [string index $new_state 1]
1260
1261        if {[catch {set info $file_states($path)}]} {
1262                set state __
1263                set icon n[incr next_icon_id]
1264        } else {
1265                set state [lindex $info 0]
1266                set icon [lindex $info 1]
1267                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1268                if {$index_info eq {}} {set index_info [lindex $info 3]}
1269        }
1270
1271        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1272        elseif {$s0 eq {_}} {set s0 _}
1273
1274        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1275        elseif {$s1 eq {_}} {set s1 _}
1276
1277        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1278                set head_info [list 0 $null_sha1]
1279        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1280                && $head_info eq {}} {
1281                set head_info $index_info
1282        }
1283
1284        set file_states($path) [list $s0$s1 $icon \
1285                $head_info $index_info \
1286                ]
1287        return $state
1288}
1289
1290proc display_file_helper {w path icon_name old_m new_m} {
1291        global file_lists
1292
1293        if {$new_m eq {_}} {
1294                set lno [lsearch -sorted $file_lists($w) $path]
1295                if {$lno >= 0} {
1296                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1297                        incr lno
1298                        $w conf -state normal
1299                        $w delete $lno.0 [expr {$lno + 1}].0
1300                        $w conf -state disabled
1301                }
1302        } elseif {$old_m eq {_} && $new_m ne {_}} {
1303                lappend file_lists($w) $path
1304                set file_lists($w) [lsort -unique $file_lists($w)]
1305                set lno [lsearch -sorted $file_lists($w) $path]
1306                incr lno
1307                $w conf -state normal
1308                $w image create $lno.0 \
1309                        -align center -padx 5 -pady 1 \
1310                        -name $icon_name \
1311                        -image [mapicon $w $new_m $path]
1312                $w insert $lno.1 "[escape_path $path]\n"
1313                $w conf -state disabled
1314        } elseif {$old_m ne $new_m} {
1315                $w conf -state normal
1316                $w image conf $icon_name -image [mapicon $w $new_m $path]
1317                $w conf -state disabled
1318        }
1319}
1320
1321proc display_file {path state} {
1322        global file_states selected_paths
1323        global ui_index ui_workdir
1324
1325        set old_m [merge_state $path $state]
1326        set s $file_states($path)
1327        set new_m [lindex $s 0]
1328        set icon_name [lindex $s 1]
1329
1330        display_file_helper     $ui_index $path $icon_name \
1331                [string index $old_m 0] \
1332                [string index $new_m 0]
1333        display_file_helper     $ui_workdir $path $icon_name \
1334                [string index $old_m 1] \
1335                [string index $new_m 1]
1336
1337        if {$new_m eq {__}} {
1338                unset file_states($path)
1339                catch {unset selected_paths($path)}
1340        }
1341}
1342
1343proc display_all_files_helper {w path icon_name m} {
1344        global file_lists
1345
1346        lappend file_lists($w) $path
1347        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1348        $w image create end \
1349                -align center -padx 5 -pady 1 \
1350                -name $icon_name \
1351                -image [mapicon $w $m $path]
1352        $w insert end "[escape_path $path]\n"
1353}
1354
1355proc display_all_files {} {
1356        global ui_index ui_workdir
1357        global file_states file_lists
1358        global last_clicked
1359
1360        $ui_index conf -state normal
1361        $ui_workdir conf -state normal
1362
1363        $ui_index delete 0.0 end
1364        $ui_workdir delete 0.0 end
1365        set last_clicked {}
1366
1367        set file_lists($ui_index) [list]
1368        set file_lists($ui_workdir) [list]
1369
1370        foreach path [lsort [array names file_states]] {
1371                set s $file_states($path)
1372                set m [lindex $s 0]
1373                set icon_name [lindex $s 1]
1374
1375                if {[string index $m 0] ne {_}} {
1376                        display_all_files_helper $ui_index $path \
1377                                $icon_name [string index $m 0]
1378                }
1379                if {[string index $m 1] ne {_}} {
1380                        display_all_files_helper $ui_workdir $path \
1381                                $icon_name [string index $m 1]
1382                }
1383        }
1384
1385        $ui_index conf -state disabled
1386        $ui_workdir conf -state disabled
1387}
1388
1389proc update_indexinfo {msg pathList after} {
1390        global update_index_cp ui_status_value
1391
1392        if {![lock_index update]} return
1393
1394        set update_index_cp 0
1395        set pathList [lsort $pathList]
1396        set totalCnt [llength $pathList]
1397        set batch [expr {int($totalCnt * .01) + 1}]
1398        if {$batch > 25} {set batch 25}
1399
1400        set ui_status_value [format \
1401                "$msg... %i/%i files (%.2f%%)" \
1402                $update_index_cp \
1403                $totalCnt \
1404                0.0]
1405        set fd [open "| git update-index -z --index-info" w]
1406        fconfigure $fd \
1407                -blocking 0 \
1408                -buffering full \
1409                -buffersize 512 \
1410                -translation binary
1411        fileevent $fd writable [list \
1412                write_update_indexinfo \
1413                $fd \
1414                $pathList \
1415                $totalCnt \
1416                $batch \
1417                $msg \
1418                $after \
1419                ]
1420}
1421
1422proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1423        global update_index_cp ui_status_value
1424        global file_states current_diff
1425
1426        if {$update_index_cp >= $totalCnt} {
1427                close $fd
1428                unlock_index
1429                uplevel #0 $after
1430                return
1431        }
1432
1433        for {set i $batch} \
1434                {$update_index_cp < $totalCnt && $i > 0} \
1435                {incr i -1} {
1436                set path [lindex $pathList $update_index_cp]
1437                incr update_index_cp
1438
1439                set s $file_states($path)
1440                switch -glob -- [lindex $s 0] {
1441                A? {set new _O}
1442                M? {set new _M}
1443                D_ {set new _D}
1444                D? {set new _?}
1445                ?? {continue}
1446                }
1447                set info [lindex $s 2]
1448                if {$info eq {}} continue
1449
1450                puts -nonewline $fd "$info\t$path\0"
1451                display_file $path $new
1452        }
1453
1454        set ui_status_value [format \
1455                "$msg... %i/%i files (%.2f%%)" \
1456                $update_index_cp \
1457                $totalCnt \
1458                [expr {100.0 * $update_index_cp / $totalCnt}]]
1459}
1460
1461proc update_index {msg pathList after} {
1462        global update_index_cp ui_status_value
1463
1464        if {![lock_index update]} return
1465
1466        set update_index_cp 0
1467        set pathList [lsort $pathList]
1468        set totalCnt [llength $pathList]
1469        set batch [expr {int($totalCnt * .01) + 1}]
1470        if {$batch > 25} {set batch 25}
1471
1472        set ui_status_value [format \
1473                "$msg... %i/%i files (%.2f%%)" \
1474                $update_index_cp \
1475                $totalCnt \
1476                0.0]
1477        set fd [open "| git update-index --add --remove -z --stdin" w]
1478        fconfigure $fd \
1479                -blocking 0 \
1480                -buffering full \
1481                -buffersize 512 \
1482                -translation binary
1483        fileevent $fd writable [list \
1484                write_update_index \
1485                $fd \
1486                $pathList \
1487                $totalCnt \
1488                $batch \
1489                $msg \
1490                $after \
1491                ]
1492}
1493
1494proc write_update_index {fd pathList totalCnt batch msg after} {
1495        global update_index_cp ui_status_value
1496        global file_states current_diff
1497
1498        if {$update_index_cp >= $totalCnt} {
1499                close $fd
1500                unlock_index
1501                uplevel #0 $after
1502                return
1503        }
1504
1505        for {set i $batch} \
1506                {$update_index_cp < $totalCnt && $i > 0} \
1507                {incr i -1} {
1508                set path [lindex $pathList $update_index_cp]
1509                incr update_index_cp
1510
1511                switch -glob -- [lindex $file_states($path) 0] {
1512                AD {set new __}
1513                ?D {set new D_}
1514                _O -
1515                AM {set new A_}
1516                U_ -
1517                ?M {set new M_}
1518                ?? {continue}
1519                }
1520                puts -nonewline $fd "$path\0"
1521                display_file $path $new
1522        }
1523
1524        set ui_status_value [format \
1525                "$msg... %i/%i files (%.2f%%)" \
1526                $update_index_cp \
1527                $totalCnt \
1528                [expr {100.0 * $update_index_cp / $totalCnt}]]
1529}
1530
1531proc checkout_index {msg pathList after} {
1532        global update_index_cp ui_status_value
1533
1534        if {![lock_index update]} return
1535
1536        set update_index_cp 0
1537        set pathList [lsort $pathList]
1538        set totalCnt [llength $pathList]
1539        set batch [expr {int($totalCnt * .01) + 1}]
1540        if {$batch > 25} {set batch 25}
1541
1542        set ui_status_value [format \
1543                "$msg... %i/%i files (%.2f%%)" \
1544                $update_index_cp \
1545                $totalCnt \
1546                0.0]
1547        set cmd [list git checkout-index]
1548        lappend cmd --index
1549        lappend cmd --quiet
1550        lappend cmd --force
1551        lappend cmd -z
1552        lappend cmd --stdin
1553        set fd [open "| $cmd " w]
1554        fconfigure $fd \
1555                -blocking 0 \
1556                -buffering full \
1557                -buffersize 512 \
1558                -translation binary
1559        fileevent $fd writable [list \
1560                write_checkout_index \
1561                $fd \
1562                $pathList \
1563                $totalCnt \
1564                $batch \
1565                $msg \
1566                $after \
1567                ]
1568}
1569
1570proc write_checkout_index {fd pathList totalCnt batch msg after} {
1571        global update_index_cp ui_status_value
1572        global file_states current_diff
1573
1574        if {$update_index_cp >= $totalCnt} {
1575                close $fd
1576                unlock_index
1577                uplevel #0 $after
1578                return
1579        }
1580
1581        for {set i $batch} \
1582                {$update_index_cp < $totalCnt && $i > 0} \
1583                {incr i -1} {
1584                set path [lindex $pathList $update_index_cp]
1585                incr update_index_cp
1586                switch -glob -- [lindex $file_states($path) 0] {
1587                U? {continue}
1588                ?M -
1589                ?D {
1590                        puts -nonewline $fd "$path\0"
1591                        display_file $path ?_
1592                }
1593                }
1594        }
1595
1596        set ui_status_value [format \
1597                "$msg... %i/%i files (%.2f%%)" \
1598                $update_index_cp \
1599                $totalCnt \
1600                [expr {100.0 * $update_index_cp / $totalCnt}]]
1601}
1602
1603######################################################################
1604##
1605## branch management
1606
1607proc load_all_heads {} {
1608        global all_heads tracking_branches
1609
1610        set all_heads [list]
1611        set cmd [list git for-each-ref]
1612        lappend cmd --format=%(refname)
1613        lappend cmd refs/heads
1614        set fd [open "| $cmd" r]
1615        while {[gets $fd line] > 0} {
1616                if {![catch {set info $tracking_branches($line)}]} continue
1617                if {![regsub ^refs/heads/ $line {} name]} continue
1618                lappend all_heads $name
1619        }
1620        close $fd
1621
1622        set all_heads [lsort $all_heads]
1623}
1624
1625proc populate_branch_menu {m} {
1626        global all_heads disable_on_lock
1627
1628        $m add separator
1629        foreach b $all_heads {
1630                $m add radiobutton \
1631                        -label $b \
1632                        -command [list switch_branch $b] \
1633                        -variable current_branch \
1634                        -value $b \
1635                        -font font_ui
1636                lappend disable_on_lock \
1637                        [list $m entryconf [$m index last] -state]
1638        }
1639}
1640
1641proc do_create_branch {} {
1642        error "NOT IMPLEMENTED"
1643}
1644
1645proc do_delete_branch {} {
1646        error "NOT IMPLEMENTED"
1647}
1648
1649proc switch_branch {b} {
1650        global HEAD commit_type file_states current_branch
1651        global selected_commit_type ui_comm
1652
1653        if {![lock_index switch]} return
1654
1655        # -- Backup the selected branch (repository_state resets it)
1656        #
1657        set new_branch $current_branch
1658
1659        # -- Our in memory state should match the repository.
1660        #
1661        repository_state curType curHEAD curMERGE_HEAD
1662        if {[string match amend* $commit_type]
1663                && $curType eq {normal}
1664                && $curHEAD eq $HEAD} {
1665        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1666                info_popup {Last scanned state does not match repository state.
1667
1668Another Git program has modified this repository
1669since the last scan.  A rescan must be performed
1670before the current branch can be changed.
1671
1672The rescan will be automatically started now.
1673}
1674                unlock_index
1675                rescan {set ui_status_value {Ready.}}
1676                return
1677        }
1678
1679        # -- Toss the message buffer if we are in amend mode.
1680        #
1681        if {[string match amend* $curType]} {
1682                $ui_comm delete 0.0 end
1683                $ui_comm edit reset
1684                $ui_comm edit modified false
1685        }
1686
1687        set selected_commit_type new
1688        set current_branch $new_branch
1689
1690        unlock_index
1691        error "NOT FINISHED"
1692}
1693
1694######################################################################
1695##
1696## remote management
1697
1698proc load_all_remotes {} {
1699        global repo_config
1700        global all_remotes tracking_branches
1701
1702        set all_remotes [list]
1703        array unset tracking_branches
1704
1705        set rm_dir [gitdir remotes]
1706        if {[file isdirectory $rm_dir]} {
1707                set all_remotes [glob \
1708                        -types f \
1709                        -tails \
1710                        -nocomplain \
1711                        -directory $rm_dir *]
1712
1713                foreach name $all_remotes {
1714                        catch {
1715                                set fd [open [file join $rm_dir $name] r]
1716                                while {[gets $fd line] >= 0} {
1717                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
1718                                                $line line src dst]} continue
1719                                        if {![regexp ^refs/ $dst]} {
1720                                                set dst "refs/heads/$dst"
1721                                        }
1722                                        set tracking_branches($dst) [list $name $src]
1723                                }
1724                                close $fd
1725                        }
1726                }
1727        }
1728
1729        foreach line [array names repo_config remote.*.url] {
1730                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1731                lappend all_remotes $name
1732
1733                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1734                        set fl {}
1735                }
1736                foreach line $fl {
1737                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1738                        if {![regexp ^refs/ $dst]} {
1739                                set dst "refs/heads/$dst"
1740                        }
1741                        set tracking_branches($dst) [list $name $src]
1742                }
1743        }
1744
1745        set all_remotes [lsort -unique $all_remotes]
1746}
1747
1748proc populate_fetch_menu {m} {
1749        global all_remotes repo_config
1750
1751        foreach r $all_remotes {
1752                set enable 0
1753                if {![catch {set a $repo_config(remote.$r.url)}]} {
1754                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1755                                set enable 1
1756                        }
1757                } else {
1758                        catch {
1759                                set fd [open [gitdir remotes $r] r]
1760                                while {[gets $fd n] >= 0} {
1761                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1762                                                set enable 1
1763                                                break
1764                                        }
1765                                }
1766                                close $fd
1767                        }
1768                }
1769
1770                if {$enable} {
1771                        $m add command \
1772                                -label "Fetch from $r..." \
1773                                -command [list fetch_from $r] \
1774                                -font font_ui
1775                }
1776        }
1777}
1778
1779proc populate_push_menu {m} {
1780        global all_remotes repo_config
1781
1782        foreach r $all_remotes {
1783                set enable 0
1784                if {![catch {set a $repo_config(remote.$r.url)}]} {
1785                        if {![catch {set a $repo_config(remote.$r.push)}]} {
1786                                set enable 1
1787                        }
1788                } else {
1789                        catch {
1790                                set fd [open [gitdir remotes $r] r]
1791                                while {[gets $fd n] >= 0} {
1792                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1793                                                set enable 1
1794                                                break
1795                                        }
1796                                }
1797                                close $fd
1798                        }
1799                }
1800
1801                if {$enable} {
1802                        $m add command \
1803                                -label "Push to $r..." \
1804                                -command [list push_to $r] \
1805                                -font font_ui
1806                }
1807        }
1808}
1809
1810proc populate_pull_menu {m} {
1811        global repo_config all_remotes disable_on_lock
1812
1813        foreach remote $all_remotes {
1814                set rb_list [list]
1815                if {[array get repo_config remote.$remote.url] ne {}} {
1816                        if {[array get repo_config remote.$remote.fetch] ne {}} {
1817                                foreach line $repo_config(remote.$remote.fetch) {
1818                                        if {[regexp {^([^:]+):} $line line rb]} {
1819                                                lappend rb_list $rb
1820                                        }
1821                                }
1822                        }
1823                } else {
1824                        catch {
1825                                set fd [open [gitdir remotes $remote] r]
1826                                while {[gets $fd line] >= 0} {
1827                                        if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1828                                                lappend rb_list $rb
1829                                        }
1830                                }
1831                                close $fd
1832                        }
1833                }
1834
1835                foreach rb $rb_list {
1836                        regsub ^refs/heads/ $rb {} rb_short
1837                        $m add command \
1838                                -label "Branch $rb_short from $remote..." \
1839                                -command [list pull_remote $remote $rb] \
1840                                -font font_ui
1841                        lappend disable_on_lock \
1842                                [list $m entryconf [$m index last] -state]
1843                }
1844        }
1845}
1846
1847######################################################################
1848##
1849## icons
1850
1851set filemask {
1852#define mask_width 14
1853#define mask_height 15
1854static unsigned char mask_bits[] = {
1855   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1856   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1857   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1858}
1859
1860image create bitmap file_plain -background white -foreground black -data {
1861#define plain_width 14
1862#define plain_height 15
1863static unsigned char plain_bits[] = {
1864   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1865   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1866   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1867} -maskdata $filemask
1868
1869image create bitmap file_mod -background white -foreground blue -data {
1870#define mod_width 14
1871#define mod_height 15
1872static unsigned char mod_bits[] = {
1873   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1874   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1875   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1876} -maskdata $filemask
1877
1878image create bitmap file_fulltick -background white -foreground "#007000" -data {
1879#define file_fulltick_width 14
1880#define file_fulltick_height 15
1881static unsigned char file_fulltick_bits[] = {
1882   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1883   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1884   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1885} -maskdata $filemask
1886
1887image create bitmap file_parttick -background white -foreground "#005050" -data {
1888#define parttick_width 14
1889#define parttick_height 15
1890static unsigned char parttick_bits[] = {
1891   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1892   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1893   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1894} -maskdata $filemask
1895
1896image create bitmap file_question -background white -foreground black -data {
1897#define file_question_width 14
1898#define file_question_height 15
1899static unsigned char file_question_bits[] = {
1900   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1901   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1902   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1903} -maskdata $filemask
1904
1905image create bitmap file_removed -background white -foreground red -data {
1906#define file_removed_width 14
1907#define file_removed_height 15
1908static unsigned char file_removed_bits[] = {
1909   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1910   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1911   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1912} -maskdata $filemask
1913
1914image create bitmap file_merge -background white -foreground blue -data {
1915#define file_merge_width 14
1916#define file_merge_height 15
1917static unsigned char file_merge_bits[] = {
1918   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1919   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1920   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1921} -maskdata $filemask
1922
1923set ui_index .vpane.files.index.list
1924set ui_workdir .vpane.files.workdir.list
1925
1926set all_icons(_$ui_index)   file_plain
1927set all_icons(A$ui_index)   file_fulltick
1928set all_icons(M$ui_index)   file_fulltick
1929set all_icons(D$ui_index)   file_removed
1930set all_icons(U$ui_index)   file_merge
1931
1932set all_icons(_$ui_workdir) file_plain
1933set all_icons(M$ui_workdir) file_mod
1934set all_icons(D$ui_workdir) file_question
1935set all_icons(O$ui_workdir) file_plain
1936
1937set max_status_desc 0
1938foreach i {
1939                {__ "Unmodified"}
1940
1941                {_M "Modified, not staged"}
1942                {M_ "Staged for commit"}
1943                {MM "Portions staged for commit"}
1944                {MD "Staged for commit, missing"}
1945
1946                {_O "Untracked, not staged"}
1947                {A_ "Staged for commit"}
1948                {AM "Portions staged for commit"}
1949                {AD "Staged for commit, missing"}
1950
1951                {_D "Missing"}
1952                {D_ "Staged for removal"}
1953                {DO "Staged for removal, still present"}
1954
1955                {U_ "Requires merge resolution"}
1956                {UM "Requires merge resolution"}
1957                {UD "Requires merge resolution"}
1958        } {
1959        if {$max_status_desc < [string length [lindex $i 1]]} {
1960                set max_status_desc [string length [lindex $i 1]]
1961        }
1962        set all_descs([lindex $i 0]) [lindex $i 1]
1963}
1964unset i
1965
1966######################################################################
1967##
1968## util
1969
1970proc is_MacOSX {} {
1971        global tcl_platform tk_library
1972        if {[tk windowingsystem] eq {aqua}} {
1973                return 1
1974        }
1975        return 0
1976}
1977
1978proc is_Windows {} {
1979        global tcl_platform
1980        if {$tcl_platform(platform) eq {windows}} {
1981                return 1
1982        }
1983        return 0
1984}
1985
1986proc bind_button3 {w cmd} {
1987        bind $w <Any-Button-3> $cmd
1988        if {[is_MacOSX]} {
1989                bind $w <Control-Button-1> $cmd
1990        }
1991}
1992
1993proc incr_font_size {font {amt 1}} {
1994        set sz [font configure $font -size]
1995        incr sz $amt
1996        font configure $font -size $sz
1997        font configure ${font}bold -size $sz
1998}
1999
2000proc hook_failed_popup {hook msg} {
2001        set w .hookfail
2002        toplevel $w
2003
2004        frame $w.m
2005        label $w.m.l1 -text "$hook hook failed:" \
2006                -anchor w \
2007                -justify left \
2008                -font font_uibold
2009        text $w.m.t \
2010                -background white -borderwidth 1 \
2011                -relief sunken \
2012                -width 80 -height 10 \
2013                -font font_diff \
2014                -yscrollcommand [list $w.m.sby set]
2015        label $w.m.l2 \
2016                -text {You must correct the above errors before committing.} \
2017                -anchor w \
2018                -justify left \
2019                -font font_uibold
2020        scrollbar $w.m.sby -command [list $w.m.t yview]
2021        pack $w.m.l1 -side top -fill x
2022        pack $w.m.l2 -side bottom -fill x
2023        pack $w.m.sby -side right -fill y
2024        pack $w.m.t -side left -fill both -expand 1
2025        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2026
2027        $w.m.t insert 1.0 $msg
2028        $w.m.t conf -state disabled
2029
2030        button $w.ok -text OK \
2031                -width 15 \
2032                -font font_ui \
2033                -command "destroy $w"
2034        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2035
2036        bind $w <Visibility> "grab $w; focus $w"
2037        bind $w <Key-Return> "destroy $w"
2038        wm title $w "[appname] ([reponame]): error"
2039        tkwait window $w
2040}
2041
2042set next_console_id 0
2043
2044proc new_console {short_title long_title} {
2045        global next_console_id console_data
2046        set w .console[incr next_console_id]
2047        set console_data($w) [list $short_title $long_title]
2048        return [console_init $w]
2049}
2050
2051proc console_init {w} {
2052        global console_cr console_data M1B
2053
2054        set console_cr($w) 1.0
2055        toplevel $w
2056        frame $w.m
2057        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2058                -anchor w \
2059                -justify left \
2060                -font font_uibold
2061        text $w.m.t \
2062                -background white -borderwidth 1 \
2063                -relief sunken \
2064                -width 80 -height 10 \
2065                -font font_diff \
2066                -state disabled \
2067                -yscrollcommand [list $w.m.sby set]
2068        label $w.m.s -text {Working... please wait...} \
2069                -anchor w \
2070                -justify left \
2071                -font font_uibold
2072        scrollbar $w.m.sby -command [list $w.m.t yview]
2073        pack $w.m.l1 -side top -fill x
2074        pack $w.m.s -side bottom -fill x
2075        pack $w.m.sby -side right -fill y
2076        pack $w.m.t -side left -fill both -expand 1
2077        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2078
2079        menu $w.ctxm -tearoff 0
2080        $w.ctxm add command -label "Copy" \
2081                -font font_ui \
2082                -command "tk_textCopy $w.m.t"
2083        $w.ctxm add command -label "Select All" \
2084                -font font_ui \
2085                -command "$w.m.t tag add sel 0.0 end"
2086        $w.ctxm add command -label "Copy All" \
2087                -font font_ui \
2088                -command "
2089                        $w.m.t tag add sel 0.0 end
2090                        tk_textCopy $w.m.t
2091                        $w.m.t tag remove sel 0.0 end
2092                "
2093
2094        button $w.ok -text {Close} \
2095                -font font_ui \
2096                -state disabled \
2097                -command "destroy $w"
2098        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2099
2100        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2101        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2102        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2103        bind $w <Visibility> "focus $w"
2104        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2105        return $w
2106}
2107
2108proc console_exec {w cmd {after {}}} {
2109        # -- Windows tosses the enviroment when we exec our child.
2110        #    But most users need that so we have to relogin. :-(
2111        #
2112        if {[is_Windows]} {
2113                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2114        }
2115
2116        # -- Tcl won't let us redirect both stdout and stderr to
2117        #    the same pipe.  So pass it through cat...
2118        #
2119        set cmd [concat | $cmd |& cat]
2120
2121        set fd_f [open $cmd r]
2122        fconfigure $fd_f -blocking 0 -translation binary
2123        fileevent $fd_f readable [list console_read $w $fd_f $after]
2124}
2125
2126proc console_read {w fd after} {
2127        global console_cr console_data
2128
2129        set buf [read $fd]
2130        if {$buf ne {}} {
2131                if {![winfo exists $w]} {console_init $w}
2132                $w.m.t conf -state normal
2133                set c 0
2134                set n [string length $buf]
2135                while {$c < $n} {
2136                        set cr [string first "\r" $buf $c]
2137                        set lf [string first "\n" $buf $c]
2138                        if {$cr < 0} {set cr [expr {$n + 1}]}
2139                        if {$lf < 0} {set lf [expr {$n + 1}]}
2140
2141                        if {$lf < $cr} {
2142                                $w.m.t insert end [string range $buf $c $lf]
2143                                set console_cr($w) [$w.m.t index {end -1c}]
2144                                set c $lf
2145                                incr c
2146                        } else {
2147                                $w.m.t delete $console_cr($w) end
2148                                $w.m.t insert end "\n"
2149                                $w.m.t insert end [string range $buf $c $cr]
2150                                set c $cr
2151                                incr c
2152                        }
2153                }
2154                $w.m.t conf -state disabled
2155                $w.m.t see end
2156        }
2157
2158        fconfigure $fd -blocking 1
2159        if {[eof $fd]} {
2160                if {[catch {close $fd}]} {
2161                        if {![winfo exists $w]} {console_init $w}
2162                        $w.m.s conf -background red -text {Error: Command Failed}
2163                        $w.ok conf -state normal
2164                        set ok 0
2165                } elseif {[winfo exists $w]} {
2166                        $w.m.s conf -background green -text {Success}
2167                        $w.ok conf -state normal
2168                        set ok 1
2169                }
2170                array unset console_cr $w
2171                array unset console_data $w
2172                if {$after ne {}} {
2173                        uplevel #0 $after $ok
2174                }
2175                return
2176        }
2177        fconfigure $fd -blocking 0
2178}
2179
2180######################################################################
2181##
2182## ui commands
2183
2184set starting_gitk_msg {Starting gitk... please wait...}
2185
2186proc do_gitk {revs} {
2187        global ui_status_value starting_gitk_msg
2188
2189        set cmd gitk
2190        if {$revs ne {}} {
2191                append cmd { }
2192                append cmd $revs
2193        }
2194        if {[is_Windows]} {
2195                set cmd "sh -c \"exec $cmd\""
2196        }
2197        append cmd { &}
2198
2199        if {[catch {eval exec $cmd} err]} {
2200                error_popup "Failed to start gitk:\n\n$err"
2201        } else {
2202                set ui_status_value $starting_gitk_msg
2203                after 10000 {
2204                        if {$ui_status_value eq $starting_gitk_msg} {
2205                                set ui_status_value {Ready.}
2206                        }
2207                }
2208        }
2209}
2210
2211proc do_gc {} {
2212        set w [new_console {gc} {Compressing the object database}]
2213        console_exec $w {git gc}
2214}
2215
2216proc do_fsck_objects {} {
2217        set w [new_console {fsck-objects} \
2218                {Verifying the object database with fsck-objects}]
2219        set cmd [list git fsck-objects]
2220        lappend cmd --full
2221        lappend cmd --cache
2222        lappend cmd --strict
2223        console_exec $w $cmd
2224}
2225
2226set is_quitting 0
2227
2228proc do_quit {} {
2229        global ui_comm is_quitting repo_config commit_type
2230
2231        if {$is_quitting} return
2232        set is_quitting 1
2233
2234        # -- Stash our current commit buffer.
2235        #
2236        set save [gitdir GITGUI_MSG]
2237        set msg [string trim [$ui_comm get 0.0 end]]
2238        if {![string match amend* $commit_type]
2239                && [$ui_comm edit modified]
2240                && $msg ne {}} {
2241                catch {
2242                        set fd [open $save w]
2243                        puts $fd [string trim [$ui_comm get 0.0 end]]
2244                        close $fd
2245                }
2246        } else {
2247                catch {file delete $save}
2248        }
2249
2250        # -- Stash our current window geometry into this repository.
2251        #
2252        set cfg_geometry [list]
2253        lappend cfg_geometry [wm geometry .]
2254        lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2255        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2256        if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2257                set rc_geometry {}
2258        }
2259        if {$cfg_geometry ne $rc_geometry} {
2260                catch {exec git repo-config gui.geometry $cfg_geometry}
2261        }
2262
2263        destroy .
2264}
2265
2266proc do_rescan {} {
2267        rescan {set ui_status_value {Ready.}}
2268}
2269
2270proc unstage_helper {txt paths} {
2271        global file_states current_diff
2272
2273        if {![lock_index begin-update]} return
2274
2275        set pathList [list]
2276        set after {}
2277        foreach path $paths {
2278                switch -glob -- [lindex $file_states($path) 0] {
2279                A? -
2280                M? -
2281                D? {
2282                        lappend pathList $path
2283                        if {$path eq $current_diff} {
2284                                set after {reshow_diff;}
2285                        }
2286                }
2287                }
2288        }
2289        if {$pathList eq {}} {
2290                unlock_index
2291        } else {
2292                update_indexinfo \
2293                        $txt \
2294                        $pathList \
2295                        [concat $after {set ui_status_value {Ready.}}]
2296        }
2297}
2298
2299proc do_unstage_selection {} {
2300        global current_diff selected_paths
2301
2302        if {[array size selected_paths] > 0} {
2303                unstage_helper \
2304                        {Unstaging selected files from commit} \
2305                        [array names selected_paths]
2306        } elseif {$current_diff ne {}} {
2307                unstage_helper \
2308                        "Unstaging [short_path $current_diff] from commit" \
2309                        [list $current_diff]
2310        }
2311}
2312
2313proc add_helper {txt paths} {
2314        global file_states current_diff
2315
2316        if {![lock_index begin-update]} return
2317
2318        set pathList [list]
2319        set after {}
2320        foreach path $paths {
2321                switch -glob -- [lindex $file_states($path) 0] {
2322                _O -
2323                ?M -
2324                ?D -
2325                U? {
2326                        lappend pathList $path
2327                        if {$path eq $current_diff} {
2328                                set after {reshow_diff;}
2329                        }
2330                }
2331                }
2332        }
2333        if {$pathList eq {}} {
2334                unlock_index
2335        } else {
2336                update_index \
2337                        $txt \
2338                        $pathList \
2339                        [concat $after {set ui_status_value {Ready to commit.}}]
2340        }
2341}
2342
2343proc do_add_selection {} {
2344        global current_diff selected_paths
2345
2346        if {[array size selected_paths] > 0} {
2347                add_helper \
2348                        {Adding selected files} \
2349                        [array names selected_paths]
2350        } elseif {$current_diff ne {}} {
2351                add_helper \
2352                        "Adding [short_path $current_diff]" \
2353                        [list $current_diff]
2354        }
2355}
2356
2357proc do_add_all {} {
2358        global file_states
2359
2360        set paths [list]
2361        foreach path [array names file_states] {
2362                switch -glob -- [lindex $file_states($path) 0] {
2363                U? {continue}
2364                ?M -
2365                ?D {lappend paths $path}
2366                }
2367        }
2368        add_helper {Adding all changed files} $paths
2369}
2370
2371proc revert_helper {txt paths} {
2372        global file_states current_diff
2373
2374        if {![lock_index begin-update]} return
2375
2376        set pathList [list]
2377        set after {}
2378        foreach path $paths {
2379                switch -glob -- [lindex $file_states($path) 0] {
2380                U? {continue}
2381                ?M -
2382                ?D {
2383                        lappend pathList $path
2384                        if {$path eq $current_diff} {
2385                                set after {reshow_diff;}
2386                        }
2387                }
2388                }
2389        }
2390
2391        set n [llength $pathList]
2392        if {$n == 0} {
2393                unlock_index
2394                return
2395        } elseif {$n == 1} {
2396                set s "[short_path [lindex $pathList]]"
2397        } else {
2398                set s "these $n files"
2399        }
2400
2401        set reply [tk_dialog \
2402                .confirm_revert \
2403                "[appname] ([reponame])" \
2404                "Revert changes in $s?
2405
2406Any unadded changes will be permanently lost by the revert." \
2407                question \
2408                1 \
2409                {Do Nothing} \
2410                {Revert Changes} \
2411                ]
2412        if {$reply == 1} {
2413                checkout_index \
2414                        $txt \
2415                        $pathList \
2416                        [concat $after {set ui_status_value {Ready.}}]
2417        } else {
2418                unlock_index
2419        }
2420}
2421
2422proc do_revert_selection {} {
2423        global current_diff selected_paths
2424
2425        if {[array size selected_paths] > 0} {
2426                revert_helper \
2427                        {Reverting selected files} \
2428                        [array names selected_paths]
2429        } elseif {$current_diff ne {}} {
2430                revert_helper \
2431                        "Reverting [short_path $current_diff]" \
2432                        [list $current_diff]
2433        }
2434}
2435
2436proc do_signoff {} {
2437        global ui_comm
2438
2439        set me [committer_ident]
2440        if {$me eq {}} return
2441
2442        set sob "Signed-off-by: $me"
2443        set last [$ui_comm get {end -1c linestart} {end -1c}]
2444        if {$last ne $sob} {
2445                $ui_comm edit separator
2446                if {$last ne {}
2447                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2448                        $ui_comm insert end "\n"
2449                }
2450                $ui_comm insert end "\n$sob"
2451                $ui_comm edit separator
2452                $ui_comm see end
2453        }
2454}
2455
2456proc do_select_commit_type {} {
2457        global commit_type selected_commit_type
2458
2459        if {$selected_commit_type eq {new}
2460                && [string match amend* $commit_type]} {
2461                create_new_commit
2462        } elseif {$selected_commit_type eq {amend}
2463                && ![string match amend* $commit_type]} {
2464                load_last_commit
2465
2466                # The amend request was rejected...
2467                #
2468                if {![string match amend* $commit_type]} {
2469                        set selected_commit_type new
2470                }
2471        }
2472}
2473
2474proc do_commit {} {
2475        commit_tree
2476}
2477
2478proc do_about {} {
2479        global appvers copyright
2480        global tcl_patchLevel tk_patchLevel
2481
2482        set w .about_dialog
2483        toplevel $w
2484        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2485
2486        label $w.header -text "About [appname]" \
2487                -font font_uibold
2488        pack $w.header -side top -fill x
2489
2490        frame $w.buttons
2491        button $w.buttons.close -text {Close} \
2492                -font font_ui \
2493                -command [list destroy $w]
2494        pack $w.buttons.close -side right
2495        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2496
2497        label $w.desc \
2498                -text "[appname] - a commit creation tool for Git.
2499$copyright" \
2500                -padx 5 -pady 5 \
2501                -justify left \
2502                -anchor w \
2503                -borderwidth 1 \
2504                -relief solid \
2505                -font font_ui
2506        pack $w.desc -side top -fill x -padx 5 -pady 5
2507
2508        set v {}
2509        append v "[appname] version $appvers\n"
2510        append v "[exec git version]\n"
2511        append v "\n"
2512        if {$tcl_patchLevel eq $tk_patchLevel} {
2513                append v "Tcl/Tk version $tcl_patchLevel"
2514        } else {
2515                append v "Tcl version $tcl_patchLevel"
2516                append v ", Tk version $tk_patchLevel"
2517        }
2518
2519        label $w.vers \
2520                -text $v \
2521                -padx 5 -pady 5 \
2522                -justify left \
2523                -anchor w \
2524                -borderwidth 1 \
2525                -relief solid \
2526                -font font_ui
2527        pack $w.vers -side top -fill x -padx 5 -pady 5
2528
2529        menu $w.ctxm -tearoff 0
2530        $w.ctxm add command \
2531                -label {Copy} \
2532                -font font_ui \
2533                -command "
2534                clipboard clear
2535                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2536        "
2537
2538        bind $w <Visibility> "grab $w; focus $w"
2539        bind $w <Key-Escape> "destroy $w"
2540        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2541        wm title $w "About [appname]"
2542        tkwait window $w
2543}
2544
2545proc do_options {} {
2546        global repo_config global_config font_descs
2547        global repo_config_new global_config_new
2548
2549        array unset repo_config_new
2550        array unset global_config_new
2551        foreach name [array names repo_config] {
2552                set repo_config_new($name) $repo_config($name)
2553        }
2554        load_config 1
2555        foreach name [array names repo_config] {
2556                switch -- $name {
2557                gui.diffcontext {continue}
2558                }
2559                set repo_config_new($name) $repo_config($name)
2560        }
2561        foreach name [array names global_config] {
2562                set global_config_new($name) $global_config($name)
2563        }
2564
2565        set w .options_editor
2566        toplevel $w
2567        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2568
2569        label $w.header -text "[appname] Options" \
2570                -font font_uibold
2571        pack $w.header -side top -fill x
2572
2573        frame $w.buttons
2574        button $w.buttons.restore -text {Restore Defaults} \
2575                -font font_ui \
2576                -command do_restore_defaults
2577        pack $w.buttons.restore -side left
2578        button $w.buttons.save -text Save \
2579                -font font_ui \
2580                -command [list do_save_config $w]
2581        pack $w.buttons.save -side right
2582        button $w.buttons.cancel -text {Cancel} \
2583                -font font_ui \
2584                -command [list destroy $w]
2585        pack $w.buttons.cancel -side right -padx 5
2586        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2587
2588        labelframe $w.repo -text "[reponame] Repository" \
2589                -font font_ui \
2590                -relief raised -borderwidth 2
2591        labelframe $w.global -text {Global (All Repositories)} \
2592                -font font_ui \
2593                -relief raised -borderwidth 2
2594        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2595        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2596
2597        foreach option {
2598                {b partialinclude {Allow Partially Added Files}}
2599                {b pullsummary {Show Pull Summary}}
2600                {b trustmtime  {Trust File Modification Timestamps}}
2601                {i diffcontext {Number of Diff Context Lines}}
2602                } {
2603                set type [lindex $option 0]
2604                set name [lindex $option 1]
2605                set text [lindex $option 2]
2606                foreach f {repo global} {
2607                        switch $type {
2608                        b {
2609                                checkbutton $w.$f.$name -text $text \
2610                                        -variable ${f}_config_new(gui.$name) \
2611                                        -onvalue true \
2612                                        -offvalue false \
2613                                        -font font_ui
2614                                pack $w.$f.$name -side top -anchor w
2615                        }
2616                        i {
2617                                frame $w.$f.$name
2618                                label $w.$f.$name.l -text "$text:" -font font_ui
2619                                pack $w.$f.$name.l -side left -anchor w -fill x
2620                                spinbox $w.$f.$name.v \
2621                                        -textvariable ${f}_config_new(gui.$name) \
2622                                        -from 1 -to 99 -increment 1 \
2623                                        -width 3 \
2624                                        -font font_ui
2625                                pack $w.$f.$name.v -side right -anchor e
2626                                pack $w.$f.$name -side top -anchor w -fill x
2627                        }
2628                        }
2629                }
2630        }
2631
2632        set all_fonts [lsort [font families]]
2633        foreach option $font_descs {
2634                set name [lindex $option 0]
2635                set font [lindex $option 1]
2636                set text [lindex $option 2]
2637
2638                set global_config_new(gui.$font^^family) \
2639                        [font configure $font -family]
2640                set global_config_new(gui.$font^^size) \
2641                        [font configure $font -size]
2642
2643                frame $w.global.$name
2644                label $w.global.$name.l -text "$text:" -font font_ui
2645                pack $w.global.$name.l -side left -anchor w -fill x
2646                eval tk_optionMenu $w.global.$name.family \
2647                        global_config_new(gui.$font^^family) \
2648                        $all_fonts
2649                spinbox $w.global.$name.size \
2650                        -textvariable global_config_new(gui.$font^^size) \
2651                        -from 2 -to 80 -increment 1 \
2652                        -width 3 \
2653                        -font font_ui
2654                pack $w.global.$name.size -side right -anchor e
2655                pack $w.global.$name.family -side right -anchor e
2656                pack $w.global.$name -side top -anchor w -fill x
2657        }
2658
2659        bind $w <Visibility> "grab $w; focus $w"
2660        bind $w <Key-Escape> "destroy $w"
2661        wm title $w "[appname] ([reponame]): Options"
2662        tkwait window $w
2663}
2664
2665proc do_restore_defaults {} {
2666        global font_descs default_config repo_config
2667        global repo_config_new global_config_new
2668
2669        foreach name [array names default_config] {
2670                set repo_config_new($name) $default_config($name)
2671                set global_config_new($name) $default_config($name)
2672        }
2673
2674        foreach option $font_descs {
2675                set name [lindex $option 0]
2676                set repo_config(gui.$name) $default_config(gui.$name)
2677        }
2678        apply_config
2679
2680        foreach option $font_descs {
2681                set name [lindex $option 0]
2682                set font [lindex $option 1]
2683                set global_config_new(gui.$font^^family) \
2684                        [font configure $font -family]
2685                set global_config_new(gui.$font^^size) \
2686                        [font configure $font -size]
2687        }
2688}
2689
2690proc do_save_config {w} {
2691        if {[catch {save_config} err]} {
2692                error_popup "Failed to completely save options:\n\n$err"
2693        }
2694        reshow_diff
2695        destroy $w
2696}
2697
2698proc do_windows_shortcut {} {
2699        global argv0
2700
2701        if {[catch {
2702                set desktop [exec cygpath \
2703                        --windows \
2704                        --absolute \
2705                        --long-name \
2706                        --desktop]
2707                }]} {
2708                        set desktop .
2709        }
2710        set fn [tk_getSaveFile \
2711                -parent . \
2712                -title "[appname] ([reponame]): Create Desktop Icon" \
2713                -initialdir $desktop \
2714                -initialfile "Git [reponame].bat"]
2715        if {$fn != {}} {
2716                if {[catch {
2717                                set fd [open $fn w]
2718                                set sh [exec cygpath \
2719                                        --windows \
2720                                        --absolute \
2721                                        /bin/sh]
2722                                set me [exec cygpath \
2723                                        --unix \
2724                                        --absolute \
2725                                        $argv0]
2726                                set gd [exec cygpath \
2727                                        --unix \
2728                                        --absolute \
2729                                        [gitdir]]
2730                                set gw [exec cygpath \
2731                                        --windows \
2732                                        --absolute \
2733                                        [file dirname [gitdir]]]
2734                                regsub -all ' $me "'\\''" me
2735                                regsub -all ' $gd "'\\''" gd
2736                                puts $fd "@ECHO Entering $gw"
2737                                puts $fd "@ECHO Starting git-gui... please wait..."
2738                                puts -nonewline $fd "@\"$sh\" --login -c \""
2739                                puts -nonewline $fd "GIT_DIR='$gd'"
2740                                puts -nonewline $fd " '$me'"
2741                                puts $fd "&\""
2742                                close $fd
2743                        } err]} {
2744                        error_popup "Cannot write script:\n\n$err"
2745                }
2746        }
2747}
2748
2749proc do_macosx_app {} {
2750        global argv0 env
2751
2752        set fn [tk_getSaveFile \
2753                -parent . \
2754                -title "[appname] ([reponame]): Create Desktop Icon" \
2755                -initialdir [file join $env(HOME) Desktop] \
2756                -initialfile "Git [reponame].app"]
2757        if {$fn != {}} {
2758                if {[catch {
2759                                set Contents [file join $fn Contents]
2760                                set MacOS [file join $Contents MacOS]
2761                                set exe [file join $MacOS git-gui]
2762
2763                                file mkdir $MacOS
2764
2765                                set fd [open [file join $Contents Info.plist] w]
2766                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2767<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2768<plist version="1.0">
2769<dict>
2770        <key>CFBundleDevelopmentRegion</key>
2771        <string>English</string>
2772        <key>CFBundleExecutable</key>
2773        <string>git-gui</string>
2774        <key>CFBundleIdentifier</key>
2775        <string>org.spearce.git-gui</string>
2776        <key>CFBundleInfoDictionaryVersion</key>
2777        <string>6.0</string>
2778        <key>CFBundlePackageType</key>
2779        <string>APPL</string>
2780        <key>CFBundleSignature</key>
2781        <string>????</string>
2782        <key>CFBundleVersion</key>
2783        <string>1.0</string>
2784        <key>NSPrincipalClass</key>
2785        <string>NSApplication</string>
2786</dict>
2787</plist>}
2788                                close $fd
2789
2790                                set fd [open $exe w]
2791                                set gd [file normalize [gitdir]]
2792                                set ep [file normalize [exec git --exec-path]]
2793                                regsub -all ' $gd "'\\''" gd
2794                                regsub -all ' $ep "'\\''" ep
2795                                puts $fd "#!/bin/sh"
2796                                foreach name [array names env] {
2797                                        if {[string match GIT_* $name]} {
2798                                                regsub -all ' $env($name) "'\\''" v
2799                                                puts $fd "export $name='$v'"
2800                                        }
2801                                }
2802                                puts $fd "export PATH='$ep':\$PATH"
2803                                puts $fd "export GIT_DIR='$gd'"
2804                                puts $fd "exec [file normalize $argv0]"
2805                                close $fd
2806
2807                                file attributes $exe -permissions u+x,g+x,o+x
2808                        } err]} {
2809                        error_popup "Cannot write icon:\n\n$err"
2810                }
2811        }
2812}
2813
2814proc toggle_or_diff {w x y} {
2815        global file_states file_lists current_diff ui_index ui_workdir
2816        global last_clicked selected_paths
2817
2818        set pos [split [$w index @$x,$y] .]
2819        set lno [lindex $pos 0]
2820        set col [lindex $pos 1]
2821        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2822        if {$path eq {}} {
2823                set last_clicked {}
2824                return
2825        }
2826
2827        set last_clicked [list $w $lno]
2828        array unset selected_paths
2829        $ui_index tag remove in_sel 0.0 end
2830        $ui_workdir tag remove in_sel 0.0 end
2831
2832        if {$col == 0} {
2833                if {$current_diff eq $path} {
2834                        set after {reshow_diff;}
2835                } else {
2836                        set after {}
2837                }
2838                if {$w eq $ui_index} {
2839                        update_indexinfo \
2840                                "Unstaging [short_path $path] from commit" \
2841                                [list $path] \
2842                                [concat $after {set ui_status_value {Ready.}}]
2843                } elseif {$w eq $ui_workdir} {
2844                        update_index \
2845                                "Adding [short_path $path]" \
2846                                [list $path] \
2847                                [concat $after {set ui_status_value {Ready.}}]
2848                }
2849        } else {
2850                show_diff $path $w $lno
2851        }
2852}
2853
2854proc add_one_to_selection {w x y} {
2855        global file_lists last_clicked selected_paths
2856
2857        set lno [lindex [split [$w index @$x,$y] .] 0]
2858        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2859        if {$path eq {}} {
2860                set last_clicked {}
2861                return
2862        }
2863
2864        if {$last_clicked ne {}
2865                && [lindex $last_clicked 0] ne $w} {
2866                array unset selected_paths
2867                [lindex $last_clicked 0] tag remove in_sel 0.0 end
2868        }
2869
2870        set last_clicked [list $w $lno]
2871        if {[catch {set in_sel $selected_paths($path)}]} {
2872                set in_sel 0
2873        }
2874        if {$in_sel} {
2875                unset selected_paths($path)
2876                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2877        } else {
2878                set selected_paths($path) 1
2879                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2880        }
2881}
2882
2883proc add_range_to_selection {w x y} {
2884        global file_lists last_clicked selected_paths
2885
2886        if {[lindex $last_clicked 0] ne $w} {
2887                toggle_or_diff $w $x $y
2888                return
2889        }
2890
2891        set lno [lindex [split [$w index @$x,$y] .] 0]
2892        set lc [lindex $last_clicked 1]
2893        if {$lc < $lno} {
2894                set begin $lc
2895                set end $lno
2896        } else {
2897                set begin $lno
2898                set end $lc
2899        }
2900
2901        foreach path [lrange $file_lists($w) \
2902                [expr {$begin - 1}] \
2903                [expr {$end - 1}]] {
2904                set selected_paths($path) 1
2905        }
2906        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2907}
2908
2909######################################################################
2910##
2911## config defaults
2912
2913set cursor_ptr arrow
2914font create font_diff -family Courier -size 10
2915font create font_ui
2916catch {
2917        label .dummy
2918        eval font configure font_ui [font actual [.dummy cget -font]]
2919        destroy .dummy
2920}
2921
2922font create font_uibold
2923font create font_diffbold
2924
2925if {[is_Windows]} {
2926        set M1B Control
2927        set M1T Ctrl
2928} elseif {[is_MacOSX]} {
2929        set M1B M1
2930        set M1T Cmd
2931} else {
2932        set M1B M1
2933        set M1T M1
2934}
2935
2936proc apply_config {} {
2937        global repo_config font_descs
2938
2939        foreach option $font_descs {
2940                set name [lindex $option 0]
2941                set font [lindex $option 1]
2942                if {[catch {
2943                        foreach {cn cv} $repo_config(gui.$name) {
2944                                font configure $font $cn $cv
2945                        }
2946                        } err]} {
2947                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2948                }
2949                foreach {cn cv} [font configure $font] {
2950                        font configure ${font}bold $cn $cv
2951                }
2952                font configure ${font}bold -weight bold
2953        }
2954}
2955
2956set default_config(gui.trustmtime) false
2957set default_config(gui.pullsummary) true
2958set default_config(gui.partialinclude) false
2959set default_config(gui.diffcontext) 5
2960set default_config(gui.fontui) [font configure font_ui]
2961set default_config(gui.fontdiff) [font configure font_diff]
2962set font_descs {
2963        {fontui   font_ui   {Main Font}}
2964        {fontdiff font_diff {Diff/Console Font}}
2965}
2966load_config 0
2967apply_config
2968
2969######################################################################
2970##
2971## ui construction
2972
2973# -- Menu Bar
2974#
2975menu .mbar -tearoff 0
2976.mbar add cascade -label Repository -menu .mbar.repository
2977.mbar add cascade -label Edit -menu .mbar.edit
2978if {!$single_commit} {
2979        .mbar add cascade -label Branch -menu .mbar.branch
2980}
2981.mbar add cascade -label Commit -menu .mbar.commit
2982if {!$single_commit} {
2983        .mbar add cascade -label Fetch -menu .mbar.fetch
2984        .mbar add cascade -label Pull -menu .mbar.pull
2985        .mbar add cascade -label Push -menu .mbar.push
2986}
2987. configure -menu .mbar
2988
2989# -- Repository Menu
2990#
2991menu .mbar.repository
2992.mbar.repository add command \
2993        -label {Visualize Current Branch} \
2994        -command {do_gitk {}} \
2995        -font font_ui
2996if {![is_MacOSX]} {
2997        .mbar.repository add command \
2998                -label {Visualize All Branches} \
2999                -command {do_gitk {--all}} \
3000                -font font_ui
3001}
3002.mbar.repository add separator
3003
3004if {!$single_commit} {
3005        .mbar.repository add command -label {Compress Database} \
3006                -command do_gc \
3007                -font font_ui
3008
3009        .mbar.repository add command -label {Verify Database} \
3010                -command do_fsck_objects \
3011                -font font_ui
3012
3013        .mbar.repository add separator
3014
3015        if {[is_Windows]} {
3016                .mbar.repository add command \
3017                        -label {Create Desktop Icon} \
3018                        -command do_windows_shortcut \
3019                        -font font_ui
3020        } elseif {[is_MacOSX]} {
3021                .mbar.repository add command \
3022                        -label {Create Desktop Icon} \
3023                        -command do_macosx_app \
3024                        -font font_ui
3025        }
3026}
3027
3028.mbar.repository add command -label Quit \
3029        -command do_quit \
3030        -accelerator $M1T-Q \
3031        -font font_ui
3032
3033# -- Edit Menu
3034#
3035menu .mbar.edit
3036.mbar.edit add command -label Undo \
3037        -command {catch {[focus] edit undo}} \
3038        -accelerator $M1T-Z \
3039        -font font_ui
3040.mbar.edit add command -label Redo \
3041        -command {catch {[focus] edit redo}} \
3042        -accelerator $M1T-Y \
3043        -font font_ui
3044.mbar.edit add separator
3045.mbar.edit add command -label Cut \
3046        -command {catch {tk_textCut [focus]}} \
3047        -accelerator $M1T-X \
3048        -font font_ui
3049.mbar.edit add command -label Copy \
3050        -command {catch {tk_textCopy [focus]}} \
3051        -accelerator $M1T-C \
3052        -font font_ui
3053.mbar.edit add command -label Paste \
3054        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3055        -accelerator $M1T-V \
3056        -font font_ui
3057.mbar.edit add command -label Delete \
3058        -command {catch {[focus] delete sel.first sel.last}} \
3059        -accelerator Del \
3060        -font font_ui
3061.mbar.edit add separator
3062.mbar.edit add command -label {Select All} \
3063        -command {catch {[focus] tag add sel 0.0 end}} \
3064        -accelerator $M1T-A \
3065        -font font_ui
3066
3067# -- Branch Menu
3068#
3069if {!$single_commit} {
3070        menu .mbar.branch
3071
3072        .mbar.branch add command -label {Create...} \
3073                -command do_create_branch \
3074                -font font_ui
3075        lappend disable_on_lock [list .mbar.branch entryconf \
3076                [.mbar.branch index last] -state]
3077
3078        .mbar.branch add command -label {Delete...} \
3079                -command do_delete_branch \
3080                -font font_ui
3081        lappend disable_on_lock [list .mbar.branch entryconf \
3082                [.mbar.branch index last] -state]
3083}
3084
3085# -- Commit Menu
3086#
3087menu .mbar.commit
3088
3089.mbar.commit add radiobutton \
3090        -label {New Commit} \
3091        -command do_select_commit_type \
3092        -variable selected_commit_type \
3093        -value new \
3094        -font font_ui
3095lappend disable_on_lock \
3096        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3097
3098.mbar.commit add radiobutton \
3099        -label {Amend Last Commit} \
3100        -command do_select_commit_type \
3101        -variable selected_commit_type \
3102        -value amend \
3103        -font font_ui
3104lappend disable_on_lock \
3105        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3106
3107.mbar.commit add separator
3108
3109.mbar.commit add command -label Rescan \
3110        -command do_rescan \
3111        -accelerator F5 \
3112        -font font_ui
3113lappend disable_on_lock \
3114        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3115
3116.mbar.commit add command -label {Add To Commit} \
3117        -command do_add_selection \
3118        -font font_ui
3119lappend disable_on_lock \
3120        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3121
3122.mbar.commit add command -label {Add All To Commit} \
3123        -command do_add_all \
3124        -accelerator $M1T-I \
3125        -font font_ui
3126lappend disable_on_lock \
3127        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3128
3129.mbar.commit add command -label {Unstage From Commit} \
3130        -command do_unstage_selection \
3131        -font font_ui
3132lappend disable_on_lock \
3133        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3134
3135.mbar.commit add command -label {Revert Changes} \
3136        -command do_revert_selection \
3137        -font font_ui
3138lappend disable_on_lock \
3139        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3140
3141.mbar.commit add separator
3142
3143.mbar.commit add command -label {Sign Off} \
3144        -command do_signoff \
3145        -accelerator $M1T-S \
3146        -font font_ui
3147
3148.mbar.commit add command -label Commit \
3149        -command do_commit \
3150        -accelerator $M1T-Return \
3151        -font font_ui
3152lappend disable_on_lock \
3153        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3154
3155# -- Transport menus
3156#
3157if {!$single_commit} {
3158        menu .mbar.fetch
3159        menu .mbar.pull
3160        menu .mbar.push
3161}
3162
3163if {[is_MacOSX]} {
3164        # -- Apple Menu (Mac OS X only)
3165        #
3166        .mbar add cascade -label Apple -menu .mbar.apple
3167        menu .mbar.apple
3168
3169        .mbar.apple add command -label "About [appname]" \
3170                -command do_about \
3171                -font font_ui
3172        .mbar.apple add command -label "[appname] Options..." \
3173                -command do_options \
3174                -font font_ui
3175} else {
3176        # -- Edit Menu
3177        #
3178        .mbar.edit add separator
3179        .mbar.edit add command -label {Options...} \
3180                -command do_options \
3181                -font font_ui
3182
3183        # -- Tools Menu
3184        #
3185        if {[file exists /usr/local/miga/lib/gui-miga]
3186                && [file exists .pvcsrc]} {
3187        proc do_miga {} {
3188                global ui_status_value
3189                if {![lock_index update]} return
3190                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3191                set miga_fd [open "|$cmd" r]
3192                fconfigure $miga_fd -blocking 0
3193                fileevent $miga_fd readable [list miga_done $miga_fd]
3194                set ui_status_value {Running miga...}
3195        }
3196        proc miga_done {fd} {
3197                read $fd 512
3198                if {[eof $fd]} {
3199                        close $fd
3200                        unlock_index
3201                        rescan [list set ui_status_value {Ready.}]
3202                }
3203        }
3204        .mbar add cascade -label Tools -menu .mbar.tools
3205        menu .mbar.tools
3206        .mbar.tools add command -label "Migrate" \
3207                -command do_miga \
3208                -font font_ui
3209        lappend disable_on_lock \
3210                [list .mbar.tools entryconf [.mbar.tools index last] -state]
3211        }
3212
3213        # -- Help Menu
3214        #
3215        .mbar add cascade -label Help -menu .mbar.help
3216        menu .mbar.help
3217
3218        .mbar.help add command -label "About [appname]" \
3219                -command do_about \
3220                -font font_ui
3221}
3222
3223
3224# -- Branch Control
3225#
3226frame .branch \
3227        -borderwidth 1 \
3228        -relief sunken
3229label .branch.l1 \
3230        -text {Current Branch:} \
3231        -anchor w \
3232        -justify left \
3233        -font font_ui
3234label .branch.cb \
3235        -textvariable current_branch \
3236        -anchor w \
3237        -justify left \
3238        -font font_ui
3239pack .branch.l1 -side left
3240pack .branch.cb -side left -fill x
3241pack .branch -side top -fill x
3242
3243# -- Main Window Layout
3244#
3245panedwindow .vpane -orient vertical
3246panedwindow .vpane.files -orient horizontal
3247.vpane add .vpane.files -sticky nsew -height 100 -width 400
3248pack .vpane -anchor n -side top -fill both -expand 1
3249
3250# -- Index File List
3251#
3252frame .vpane.files.index -height 100 -width 400
3253label .vpane.files.index.title -text {Changes To Be Committed} \
3254        -background green \
3255        -font font_ui
3256text $ui_index -background white -borderwidth 0 \
3257        -width 40 -height 10 \
3258        -font font_ui \
3259        -cursor $cursor_ptr \
3260        -yscrollcommand {.vpane.files.index.sb set} \
3261        -state disabled
3262scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3263pack .vpane.files.index.title -side top -fill x
3264pack .vpane.files.index.sb -side right -fill y
3265pack $ui_index -side left -fill both -expand 1
3266.vpane.files add .vpane.files.index -sticky nsew
3267
3268# -- Working Directory File List
3269#
3270frame .vpane.files.workdir -height 100 -width 100
3271label .vpane.files.workdir.title -text {Changed But Not Updated} \
3272        -background red \
3273        -font font_ui
3274text $ui_workdir -background white -borderwidth 0 \
3275        -width 40 -height 10 \
3276        -font font_ui \
3277        -cursor $cursor_ptr \
3278        -yscrollcommand {.vpane.files.workdir.sb set} \
3279        -state disabled
3280scrollbar .vpane.files.workdir.sb -command [list $ui_workdir yview]
3281pack .vpane.files.workdir.title -side top -fill x
3282pack .vpane.files.workdir.sb -side right -fill y
3283pack $ui_workdir -side left -fill both -expand 1
3284.vpane.files add .vpane.files.workdir -sticky nsew
3285
3286foreach i [list $ui_index $ui_workdir] {
3287        $i tag conf in_diff -font font_uibold
3288        $i tag conf in_sel \
3289                -background [$i cget -foreground] \
3290                -foreground [$i cget -background]
3291}
3292unset i
3293
3294# -- Diff and Commit Area
3295#
3296frame .vpane.lower -height 300 -width 400
3297frame .vpane.lower.commarea
3298frame .vpane.lower.diff -relief sunken -borderwidth 1
3299pack .vpane.lower.commarea -side top -fill x
3300pack .vpane.lower.diff -side bottom -fill both -expand 1
3301.vpane add .vpane.lower -stick nsew
3302
3303# -- Commit Area Buttons
3304#
3305frame .vpane.lower.commarea.buttons
3306label .vpane.lower.commarea.buttons.l -text {} \
3307        -anchor w \
3308        -justify left \
3309        -font font_ui
3310pack .vpane.lower.commarea.buttons.l -side top -fill x
3311pack .vpane.lower.commarea.buttons -side left -fill y
3312
3313button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3314        -command do_rescan \
3315        -font font_ui
3316pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3317lappend disable_on_lock \
3318        {.vpane.lower.commarea.buttons.rescan conf -state}
3319
3320button .vpane.lower.commarea.buttons.incall -text {Add All} \
3321        -command do_add_all \
3322        -font font_ui
3323pack .vpane.lower.commarea.buttons.incall -side top -fill x
3324lappend disable_on_lock \
3325        {.vpane.lower.commarea.buttons.incall conf -state}
3326
3327button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3328        -command do_signoff \
3329        -font font_ui
3330pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3331
3332button .vpane.lower.commarea.buttons.commit -text {Commit} \
3333        -command do_commit \
3334        -font font_ui
3335pack .vpane.lower.commarea.buttons.commit -side top -fill x
3336lappend disable_on_lock \
3337        {.vpane.lower.commarea.buttons.commit conf -state}
3338
3339# -- Commit Message Buffer
3340#
3341frame .vpane.lower.commarea.buffer
3342frame .vpane.lower.commarea.buffer.header
3343set ui_comm .vpane.lower.commarea.buffer.t
3344set ui_coml .vpane.lower.commarea.buffer.header.l
3345radiobutton .vpane.lower.commarea.buffer.header.new \
3346        -text {New Commit} \
3347        -command do_select_commit_type \
3348        -variable selected_commit_type \
3349        -value new \
3350        -font font_ui
3351lappend disable_on_lock \
3352        [list .vpane.lower.commarea.buffer.header.new conf -state]
3353radiobutton .vpane.lower.commarea.buffer.header.amend \
3354        -text {Amend Last Commit} \
3355        -command do_select_commit_type \
3356        -variable selected_commit_type \
3357        -value amend \
3358        -font font_ui
3359lappend disable_on_lock \
3360        [list .vpane.lower.commarea.buffer.header.amend conf -state]
3361label $ui_coml \
3362        -anchor w \
3363        -justify left \
3364        -font font_ui
3365proc trace_commit_type {varname args} {
3366        global ui_coml commit_type
3367        switch -glob -- $commit_type {
3368        initial       {set txt {Initial Commit Message:}}
3369        amend         {set txt {Amended Commit Message:}}
3370        amend-initial {set txt {Amended Initial Commit Message:}}
3371        amend-merge   {set txt {Amended Merge Commit Message:}}
3372        merge         {set txt {Merge Commit Message:}}
3373        *             {set txt {Commit Message:}}
3374        }
3375        $ui_coml conf -text $txt
3376}
3377trace add variable commit_type write trace_commit_type
3378pack $ui_coml -side left -fill x
3379pack .vpane.lower.commarea.buffer.header.amend -side right
3380pack .vpane.lower.commarea.buffer.header.new -side right
3381
3382text $ui_comm -background white -borderwidth 1 \
3383        -undo true \
3384        -maxundo 20 \
3385        -autoseparators true \
3386        -relief sunken \
3387        -width 75 -height 9 -wrap none \
3388        -font font_diff \
3389        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3390scrollbar .vpane.lower.commarea.buffer.sby \
3391        -command [list $ui_comm yview]
3392pack .vpane.lower.commarea.buffer.header -side top -fill x
3393pack .vpane.lower.commarea.buffer.sby -side right -fill y
3394pack $ui_comm -side left -fill y
3395pack .vpane.lower.commarea.buffer -side left -fill y
3396
3397# -- Commit Message Buffer Context Menu
3398#
3399set ctxm .vpane.lower.commarea.buffer.ctxm
3400menu $ctxm -tearoff 0
3401$ctxm add command \
3402        -label {Cut} \
3403        -font font_ui \
3404        -command {tk_textCut $ui_comm}
3405$ctxm add command \
3406        -label {Copy} \
3407        -font font_ui \
3408        -command {tk_textCopy $ui_comm}
3409$ctxm add command \
3410        -label {Paste} \
3411        -font font_ui \
3412        -command {tk_textPaste $ui_comm}
3413$ctxm add command \
3414        -label {Delete} \
3415        -font font_ui \
3416        -command {$ui_comm delete sel.first sel.last}
3417$ctxm add separator
3418$ctxm add command \
3419        -label {Select All} \
3420        -font font_ui \
3421        -command {$ui_comm tag add sel 0.0 end}
3422$ctxm add command \
3423        -label {Copy All} \
3424        -font font_ui \
3425        -command {
3426                $ui_comm tag add sel 0.0 end
3427                tk_textCopy $ui_comm
3428                $ui_comm tag remove sel 0.0 end
3429        }
3430$ctxm add separator
3431$ctxm add command \
3432        -label {Sign Off} \
3433        -font font_ui \
3434        -command do_signoff
3435bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3436
3437# -- Diff Header
3438#
3439set current_diff {}
3440set diff_actions [list]
3441proc trace_current_diff {varname args} {
3442        global current_diff diff_actions file_states
3443        if {$current_diff eq {}} {
3444                set s {}
3445                set f {}
3446                set p {}
3447                set o disabled
3448        } else {
3449                set p $current_diff
3450                set s [mapdesc [lindex $file_states($p) 0] $p]
3451                set f {File:}
3452                set p [escape_path $p]
3453                set o normal
3454        }
3455
3456        .vpane.lower.diff.header.status configure -text $s
3457        .vpane.lower.diff.header.file configure -text $f
3458        .vpane.lower.diff.header.path configure -text $p
3459        foreach w $diff_actions {
3460                uplevel #0 $w $o
3461        }
3462}
3463trace add variable current_diff write trace_current_diff
3464
3465frame .vpane.lower.diff.header -background orange
3466label .vpane.lower.diff.header.status \
3467        -background orange \
3468        -width $max_status_desc \
3469        -anchor w \
3470        -justify left \
3471        -font font_ui
3472label .vpane.lower.diff.header.file \
3473        -background orange \
3474        -anchor w \
3475        -justify left \
3476        -font font_ui
3477label .vpane.lower.diff.header.path \
3478        -background orange \
3479        -anchor w \
3480        -justify left \
3481        -font font_ui
3482pack .vpane.lower.diff.header.status -side left
3483pack .vpane.lower.diff.header.file -side left
3484pack .vpane.lower.diff.header.path -fill x
3485set ctxm .vpane.lower.diff.header.ctxm
3486menu $ctxm -tearoff 0
3487$ctxm add command \
3488        -label {Copy} \
3489        -font font_ui \
3490        -command {
3491                clipboard clear
3492                clipboard append \
3493                        -format STRING \
3494                        -type STRING \
3495                        -- $current_diff
3496        }
3497lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3498bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3499
3500# -- Diff Body
3501#
3502frame .vpane.lower.diff.body
3503set ui_diff .vpane.lower.diff.body.t
3504text $ui_diff -background white -borderwidth 0 \
3505        -width 80 -height 15 -wrap none \
3506        -font font_diff \
3507        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3508        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3509        -state disabled
3510scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3511        -command [list $ui_diff xview]
3512scrollbar .vpane.lower.diff.body.sby -orient vertical \
3513        -command [list $ui_diff yview]
3514pack .vpane.lower.diff.body.sbx -side bottom -fill x
3515pack .vpane.lower.diff.body.sby -side right -fill y
3516pack $ui_diff -side left -fill both -expand 1
3517pack .vpane.lower.diff.header -side top -fill x
3518pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3519
3520$ui_diff tag conf d_@ -font font_diffbold
3521$ui_diff tag conf d_+  -foreground blue
3522$ui_diff tag conf d_-  -foreground red
3523$ui_diff tag conf d_++ -foreground {#00a000}
3524$ui_diff tag conf d_-- -foreground {#a000a0}
3525$ui_diff tag conf d_+- \
3526        -foreground red \
3527        -background {light goldenrod yellow}
3528$ui_diff tag conf d_-+ \
3529        -foreground blue \
3530        -background azure2
3531
3532# -- Diff Body Context Menu
3533#
3534set ctxm .vpane.lower.diff.body.ctxm
3535menu $ctxm -tearoff 0
3536$ctxm add command \
3537        -label {Copy} \
3538        -font font_ui \
3539        -command {tk_textCopy $ui_diff}
3540lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3541$ctxm add command \
3542        -label {Select All} \
3543        -font font_ui \
3544        -command {$ui_diff tag add sel 0.0 end}
3545lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3546$ctxm add command \
3547        -label {Copy All} \
3548        -font font_ui \
3549        -command {
3550                $ui_diff tag add sel 0.0 end
3551                tk_textCopy $ui_diff
3552                $ui_diff tag remove sel 0.0 end
3553        }
3554lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3555$ctxm add separator
3556$ctxm add command \
3557        -label {Decrease Font Size} \
3558        -font font_ui \
3559        -command {incr_font_size font_diff -1}
3560lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3561$ctxm add command \
3562        -label {Increase Font Size} \
3563        -font font_ui \
3564        -command {incr_font_size font_diff 1}
3565lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3566$ctxm add separator
3567$ctxm add command \
3568        -label {Show Less Context} \
3569        -font font_ui \
3570        -command {if {$repo_config(gui.diffcontext) >= 2} {
3571                incr repo_config(gui.diffcontext) -1
3572                reshow_diff
3573        }}
3574lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3575$ctxm add command \
3576        -label {Show More Context} \
3577        -font font_ui \
3578        -command {
3579                incr repo_config(gui.diffcontext)
3580                reshow_diff
3581        }
3582lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3583$ctxm add separator
3584$ctxm add command -label {Options...} \
3585        -font font_ui \
3586        -command do_options
3587bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3588
3589# -- Status Bar
3590#
3591set ui_status_value {Initializing...}
3592label .status -textvariable ui_status_value \
3593        -anchor w \
3594        -justify left \
3595        -borderwidth 1 \
3596        -relief sunken \
3597        -font font_ui
3598pack .status -anchor w -side bottom -fill x
3599
3600# -- Load geometry
3601#
3602catch {
3603set gm $repo_config(gui.geometry)
3604wm geometry . [lindex $gm 0]
3605.vpane sash place 0 \
3606        [lindex [.vpane sash coord 0] 0] \
3607        [lindex $gm 1]
3608.vpane.files sash place 0 \
3609        [lindex $gm 2] \
3610        [lindex [.vpane.files sash coord 0] 1]
3611unset gm
3612}
3613
3614# -- Key Bindings
3615#
3616bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3617bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3618bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3619bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3620bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3621bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3622bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3623bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3624bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3625bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3626bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3627
3628bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3629bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3630bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3631bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3632bind $ui_diff <$M1B-Key-v> {break}
3633bind $ui_diff <$M1B-Key-V> {break}
3634bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3635bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3636bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3637bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3638bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3639bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3640
3641bind .   <Destroy> do_quit
3642bind all <Key-F5> do_rescan
3643bind all <$M1B-Key-r> do_rescan
3644bind all <$M1B-Key-R> do_rescan
3645bind .   <$M1B-Key-s> do_signoff
3646bind .   <$M1B-Key-S> do_signoff
3647bind .   <$M1B-Key-i> do_add_all
3648bind .   <$M1B-Key-I> do_add_all
3649bind .   <$M1B-Key-Return> do_commit
3650bind all <$M1B-Key-q> do_quit
3651bind all <$M1B-Key-Q> do_quit
3652bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3653bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3654foreach i [list $ui_index $ui_workdir] {
3655        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3656        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3657        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3658}
3659unset i
3660
3661set file_lists($ui_index) [list]
3662set file_lists($ui_workdir) [list]
3663
3664set HEAD {}
3665set PARENT {}
3666set MERGE_HEAD [list]
3667set commit_type {}
3668set empty_tree {}
3669set current_branch {}
3670set current_diff {}
3671set selected_commit_type new
3672
3673wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
3674focus -force $ui_comm
3675
3676# -- Warn the user about environmental problems.  Cygwin's Tcl
3677#    does *not* pass its env array onto any processes it spawns.
3678#    This means that git processes get none of our environment.
3679#
3680if {[is_Windows]} {
3681        set ignored_env 0
3682        set suggest_user {}
3683        set msg "Possible environment issues exist.
3684
3685The following environment variables are probably
3686going to be ignored by any Git subprocess run
3687by [appname]:
3688
3689"
3690        foreach name [array names env] {
3691                switch -regexp -- $name {
3692                {^GIT_INDEX_FILE$} -
3693                {^GIT_OBJECT_DIRECTORY$} -
3694                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3695                {^GIT_DIFF_OPTS$} -
3696                {^GIT_EXTERNAL_DIFF$} -
3697                {^GIT_PAGER$} -
3698                {^GIT_TRACE$} -
3699                {^GIT_CONFIG$} -
3700                {^GIT_CONFIG_LOCAL$} -
3701                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3702                        append msg " - $name\n"
3703                        incr ignored_env
3704                }
3705                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3706                        append msg " - $name\n"
3707                        incr ignored_env
3708                        set suggest_user $name
3709                }
3710                }
3711        }
3712        if {$ignored_env > 0} {
3713                append msg "
3714This is due to a known issue with the
3715Tcl binary distributed by Cygwin."
3716
3717                if {$suggest_user ne {}} {
3718                        append msg "
3719
3720A good replacement for $suggest_user
3721is placing values for the user.name and
3722user.email settings into your personal
3723~/.gitconfig file.
3724"
3725                }
3726                warn_popup $msg
3727        }
3728        unset ignored_env msg suggest_user name
3729}
3730
3731# -- Only initialize complex UI if we are going to stay running.
3732#
3733if {!$single_commit} {
3734        load_all_remotes
3735        load_all_heads
3736
3737        populate_branch_menu .mbar.branch
3738        populate_fetch_menu .mbar.fetch
3739        populate_pull_menu .mbar.pull
3740        populate_push_menu .mbar.push
3741}
3742
3743# -- Only suggest a gc run if we are going to stay running.
3744#
3745if {!$single_commit} {
3746        set object_limit 2000
3747        if {[is_Windows]} {set object_limit 200}
3748        regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3749        if {$objects_current >= $object_limit} {
3750                if {[ask_popup \
3751                        "This repository currently has $objects_current loose objects.
3752
3753To maintain optimal performance it is strongly
3754recommended that you compress the database
3755when more than $object_limit loose objects exist.
3756
3757Compress the database now?"] eq yes} {
3758                        do_gc
3759                }
3760        }
3761        unset object_limit _junk objects_current
3762}
3763
3764lock_index begin-read
3765after 1 do_rescan