984535687cd4c24803f9c97fcd01ae80cb4c6972
   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 selected_paths
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
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
2856        global last_clicked selected_paths
2857
2858        set pos [split [$w index @$x,$y] .]
2859        set lno [lindex $pos 0]
2860        set col [lindex $pos 1]
2861        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2862        if {$path eq {}} {
2863                set last_clicked {}
2864                return
2865        }
2866
2867        set last_clicked [list $w $lno]
2868        if {[catch {set in_sel $selected_paths($path)}]} {
2869                set in_sel 0
2870        }
2871        if {$in_sel} {
2872                unset selected_paths($path)
2873                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2874        } else {
2875                set selected_paths($path) 1
2876                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2877        }
2878}
2879
2880proc add_range_to_selection {w x y} {
2881        global file_lists
2882        global last_clicked selected_paths
2883
2884        if {[lindex $last_clicked 0] ne $w} {
2885                toggle_or_diff $w $x $y
2886                return
2887        }
2888
2889        set pos [split [$w index @$x,$y] .]
2890        set lno [lindex $pos 0]
2891        set lc [lindex $last_clicked 1]
2892        if {$lc < $lno} {
2893                set begin $lc
2894                set end $lno
2895        } else {
2896                set begin $lno
2897                set end $lc
2898        }
2899
2900        foreach path [lrange $file_lists($w) \
2901                [expr {$begin - 1}] \
2902                [expr {$end - 1}]] {
2903                set selected_paths($path) 1
2904        }
2905        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2906}
2907
2908######################################################################
2909##
2910## config defaults
2911
2912set cursor_ptr arrow
2913font create font_diff -family Courier -size 10
2914font create font_ui
2915catch {
2916        label .dummy
2917        eval font configure font_ui [font actual [.dummy cget -font]]
2918        destroy .dummy
2919}
2920
2921font create font_uibold
2922font create font_diffbold
2923
2924if {[is_Windows]} {
2925        set M1B Control
2926        set M1T Ctrl
2927} elseif {[is_MacOSX]} {
2928        set M1B M1
2929        set M1T Cmd
2930} else {
2931        set M1B M1
2932        set M1T M1
2933}
2934
2935proc apply_config {} {
2936        global repo_config font_descs
2937
2938        foreach option $font_descs {
2939                set name [lindex $option 0]
2940                set font [lindex $option 1]
2941                if {[catch {
2942                        foreach {cn cv} $repo_config(gui.$name) {
2943                                font configure $font $cn $cv
2944                        }
2945                        } err]} {
2946                        error_popup "Invalid font specified in gui.$name:\n\n$err"
2947                }
2948                foreach {cn cv} [font configure $font] {
2949                        font configure ${font}bold $cn $cv
2950                }
2951                font configure ${font}bold -weight bold
2952        }
2953}
2954
2955set default_config(gui.trustmtime) false
2956set default_config(gui.pullsummary) true
2957set default_config(gui.partialinclude) false
2958set default_config(gui.diffcontext) 5
2959set default_config(gui.fontui) [font configure font_ui]
2960set default_config(gui.fontdiff) [font configure font_diff]
2961set font_descs {
2962        {fontui   font_ui   {Main Font}}
2963        {fontdiff font_diff {Diff/Console Font}}
2964}
2965load_config 0
2966apply_config
2967
2968######################################################################
2969##
2970## ui construction
2971
2972# -- Menu Bar
2973#
2974menu .mbar -tearoff 0
2975.mbar add cascade -label Repository -menu .mbar.repository
2976.mbar add cascade -label Edit -menu .mbar.edit
2977if {!$single_commit} {
2978        .mbar add cascade -label Branch -menu .mbar.branch
2979}
2980.mbar add cascade -label Commit -menu .mbar.commit
2981if {!$single_commit} {
2982        .mbar add cascade -label Fetch -menu .mbar.fetch
2983        .mbar add cascade -label Pull -menu .mbar.pull
2984        .mbar add cascade -label Push -menu .mbar.push
2985}
2986. configure -menu .mbar
2987
2988# -- Repository Menu
2989#
2990menu .mbar.repository
2991.mbar.repository add command \
2992        -label {Visualize Current Branch} \
2993        -command {do_gitk {}} \
2994        -font font_ui
2995if {![is_MacOSX]} {
2996        .mbar.repository add command \
2997                -label {Visualize All Branches} \
2998                -command {do_gitk {--all}} \
2999                -font font_ui
3000}
3001.mbar.repository add separator
3002
3003if {!$single_commit} {
3004        .mbar.repository add command -label {Compress Database} \
3005                -command do_gc \
3006                -font font_ui
3007
3008        .mbar.repository add command -label {Verify Database} \
3009                -command do_fsck_objects \
3010                -font font_ui
3011
3012        .mbar.repository add separator
3013
3014        if {[is_Windows]} {
3015                .mbar.repository add command \
3016                        -label {Create Desktop Icon} \
3017                        -command do_windows_shortcut \
3018                        -font font_ui
3019        } elseif {[is_MacOSX]} {
3020                .mbar.repository add command \
3021                        -label {Create Desktop Icon} \
3022                        -command do_macosx_app \
3023                        -font font_ui
3024        }
3025}
3026
3027.mbar.repository add command -label Quit \
3028        -command do_quit \
3029        -accelerator $M1T-Q \
3030        -font font_ui
3031
3032# -- Edit Menu
3033#
3034menu .mbar.edit
3035.mbar.edit add command -label Undo \
3036        -command {catch {[focus] edit undo}} \
3037        -accelerator $M1T-Z \
3038        -font font_ui
3039.mbar.edit add command -label Redo \
3040        -command {catch {[focus] edit redo}} \
3041        -accelerator $M1T-Y \
3042        -font font_ui
3043.mbar.edit add separator
3044.mbar.edit add command -label Cut \
3045        -command {catch {tk_textCut [focus]}} \
3046        -accelerator $M1T-X \
3047        -font font_ui
3048.mbar.edit add command -label Copy \
3049        -command {catch {tk_textCopy [focus]}} \
3050        -accelerator $M1T-C \
3051        -font font_ui
3052.mbar.edit add command -label Paste \
3053        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3054        -accelerator $M1T-V \
3055        -font font_ui
3056.mbar.edit add command -label Delete \
3057        -command {catch {[focus] delete sel.first sel.last}} \
3058        -accelerator Del \
3059        -font font_ui
3060.mbar.edit add separator
3061.mbar.edit add command -label {Select All} \
3062        -command {catch {[focus] tag add sel 0.0 end}} \
3063        -accelerator $M1T-A \
3064        -font font_ui
3065
3066# -- Branch Menu
3067#
3068if {!$single_commit} {
3069        menu .mbar.branch
3070
3071        .mbar.branch add command -label {Create...} \
3072                -command do_create_branch \
3073                -font font_ui
3074        lappend disable_on_lock [list .mbar.branch entryconf \
3075                [.mbar.branch index last] -state]
3076
3077        .mbar.branch add command -label {Delete...} \
3078                -command do_delete_branch \
3079                -font font_ui
3080        lappend disable_on_lock [list .mbar.branch entryconf \
3081                [.mbar.branch index last] -state]
3082}
3083
3084# -- Commit Menu
3085#
3086menu .mbar.commit
3087
3088.mbar.commit add radiobutton \
3089        -label {New Commit} \
3090        -command do_select_commit_type \
3091        -variable selected_commit_type \
3092        -value new \
3093        -font font_ui
3094lappend disable_on_lock \
3095        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3096
3097.mbar.commit add radiobutton \
3098        -label {Amend Last Commit} \
3099        -command do_select_commit_type \
3100        -variable selected_commit_type \
3101        -value amend \
3102        -font font_ui
3103lappend disable_on_lock \
3104        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3105
3106.mbar.commit add separator
3107
3108.mbar.commit add command -label Rescan \
3109        -command do_rescan \
3110        -accelerator F5 \
3111        -font font_ui
3112lappend disable_on_lock \
3113        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3114
3115.mbar.commit add command -label {Add To Commit} \
3116        -command do_add_selection \
3117        -font font_ui
3118lappend disable_on_lock \
3119        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3120
3121.mbar.commit add command -label {Add All To Commit} \
3122        -command do_add_all \
3123        -accelerator $M1T-I \
3124        -font font_ui
3125lappend disable_on_lock \
3126        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3127
3128.mbar.commit add command -label {Unstage From Commit} \
3129        -command do_unstage_selection \
3130        -font font_ui
3131lappend disable_on_lock \
3132        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3133
3134.mbar.commit add command -label {Revert Changes} \
3135        -command do_revert_selection \
3136        -font font_ui
3137lappend disable_on_lock \
3138        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3139
3140.mbar.commit add separator
3141
3142.mbar.commit add command -label {Sign Off} \
3143        -command do_signoff \
3144        -accelerator $M1T-S \
3145        -font font_ui
3146
3147.mbar.commit add command -label Commit \
3148        -command do_commit \
3149        -accelerator $M1T-Return \
3150        -font font_ui
3151lappend disable_on_lock \
3152        [list .mbar.commit entryconf [.mbar.commit index last] -state]
3153
3154# -- Transport menus
3155#
3156if {!$single_commit} {
3157        menu .mbar.fetch
3158        menu .mbar.pull
3159        menu .mbar.push
3160}
3161
3162if {[is_MacOSX]} {
3163        # -- Apple Menu (Mac OS X only)
3164        #
3165        .mbar add cascade -label Apple -menu .mbar.apple
3166        menu .mbar.apple
3167
3168        .mbar.apple add command -label "About [appname]" \
3169                -command do_about \
3170                -font font_ui
3171        .mbar.apple add command -label "[appname] Options..." \
3172                -command do_options \
3173                -font font_ui
3174} else {
3175        # -- Edit Menu
3176        #
3177        .mbar.edit add separator
3178        .mbar.edit add command -label {Options...} \
3179                -command do_options \
3180                -font font_ui
3181
3182        # -- Tools Menu
3183        #
3184        if {[file exists /usr/local/miga/lib/gui-miga]
3185                && [file exists .pvcsrc]} {
3186        proc do_miga {} {
3187                global ui_status_value
3188                if {![lock_index update]} return
3189                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3190                set miga_fd [open "|$cmd" r]
3191                fconfigure $miga_fd -blocking 0
3192                fileevent $miga_fd readable [list miga_done $miga_fd]
3193                set ui_status_value {Running miga...}
3194        }
3195        proc miga_done {fd} {
3196                read $fd 512
3197                if {[eof $fd]} {
3198                        close $fd
3199                        unlock_index
3200                        rescan [list set ui_status_value {Ready.}]
3201                }
3202        }
3203        .mbar add cascade -label Tools -menu .mbar.tools
3204        menu .mbar.tools
3205        .mbar.tools add command -label "Migrate" \
3206                -command do_miga \
3207                -font font_ui
3208        lappend disable_on_lock \
3209                [list .mbar.tools entryconf [.mbar.tools index last] -state]
3210        }
3211
3212        # -- Help Menu
3213        #
3214        .mbar add cascade -label Help -menu .mbar.help
3215        menu .mbar.help
3216
3217        .mbar.help add command -label "About [appname]" \
3218                -command do_about \
3219                -font font_ui
3220}
3221
3222
3223# -- Branch Control
3224#
3225frame .branch \
3226        -borderwidth 1 \
3227        -relief sunken
3228label .branch.l1 \
3229        -text {Current Branch:} \
3230        -anchor w \
3231        -justify left \
3232        -font font_ui
3233label .branch.cb \
3234        -textvariable current_branch \
3235        -anchor w \
3236        -justify left \
3237        -font font_ui
3238pack .branch.l1 -side left
3239pack .branch.cb -side left -fill x
3240pack .branch -side top -fill x
3241
3242# -- Main Window Layout
3243#
3244panedwindow .vpane -orient vertical
3245panedwindow .vpane.files -orient horizontal
3246.vpane add .vpane.files -sticky nsew -height 100 -width 400
3247pack .vpane -anchor n -side top -fill both -expand 1
3248
3249# -- Index File List
3250#
3251frame .vpane.files.index -height 100 -width 400
3252label .vpane.files.index.title -text {Changes To Be Committed} \
3253        -background green \
3254        -font font_ui
3255text $ui_index -background white -borderwidth 0 \
3256        -width 40 -height 10 \
3257        -font font_ui \
3258        -cursor $cursor_ptr \
3259        -yscrollcommand {.vpane.files.index.sb set} \
3260        -state disabled
3261scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3262pack .vpane.files.index.title -side top -fill x
3263pack .vpane.files.index.sb -side right -fill y
3264pack $ui_index -side left -fill both -expand 1
3265.vpane.files add .vpane.files.index -sticky nsew
3266
3267# -- Working Directory File List
3268#
3269frame .vpane.files.workdir -height 100 -width 100
3270label .vpane.files.workdir.title -text {Changed But Not Updated} \
3271        -background red \
3272        -font font_ui
3273text $ui_workdir -background white -borderwidth 0 \
3274        -width 40 -height 10 \
3275        -font font_ui \
3276        -cursor $cursor_ptr \
3277        -yscrollcommand {.vpane.files.workdir.sb set} \
3278        -state disabled
3279scrollbar .vpane.files.workdir.sb -command [list $ui_workdir yview]
3280pack .vpane.files.workdir.title -side top -fill x
3281pack .vpane.files.workdir.sb -side right -fill y
3282pack $ui_workdir -side left -fill both -expand 1
3283.vpane.files add .vpane.files.workdir -sticky nsew
3284
3285foreach i [list $ui_index $ui_workdir] {
3286        $i tag conf in_diff -font font_uibold
3287        $i tag conf in_sel \
3288                -background [$i cget -foreground] \
3289                -foreground [$i cget -background]
3290}
3291unset i
3292
3293# -- Diff and Commit Area
3294#
3295frame .vpane.lower -height 300 -width 400
3296frame .vpane.lower.commarea
3297frame .vpane.lower.diff -relief sunken -borderwidth 1
3298pack .vpane.lower.commarea -side top -fill x
3299pack .vpane.lower.diff -side bottom -fill both -expand 1
3300.vpane add .vpane.lower -stick nsew
3301
3302# -- Commit Area Buttons
3303#
3304frame .vpane.lower.commarea.buttons
3305label .vpane.lower.commarea.buttons.l -text {} \
3306        -anchor w \
3307        -justify left \
3308        -font font_ui
3309pack .vpane.lower.commarea.buttons.l -side top -fill x
3310pack .vpane.lower.commarea.buttons -side left -fill y
3311
3312button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3313        -command do_rescan \
3314        -font font_ui
3315pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3316lappend disable_on_lock \
3317        {.vpane.lower.commarea.buttons.rescan conf -state}
3318
3319button .vpane.lower.commarea.buttons.incall -text {Add All} \
3320        -command do_add_all \
3321        -font font_ui
3322pack .vpane.lower.commarea.buttons.incall -side top -fill x
3323lappend disable_on_lock \
3324        {.vpane.lower.commarea.buttons.incall conf -state}
3325
3326button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3327        -command do_signoff \
3328        -font font_ui
3329pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3330
3331button .vpane.lower.commarea.buttons.commit -text {Commit} \
3332        -command do_commit \
3333        -font font_ui
3334pack .vpane.lower.commarea.buttons.commit -side top -fill x
3335lappend disable_on_lock \
3336        {.vpane.lower.commarea.buttons.commit conf -state}
3337
3338# -- Commit Message Buffer
3339#
3340frame .vpane.lower.commarea.buffer
3341frame .vpane.lower.commarea.buffer.header
3342set ui_comm .vpane.lower.commarea.buffer.t
3343set ui_coml .vpane.lower.commarea.buffer.header.l
3344radiobutton .vpane.lower.commarea.buffer.header.new \
3345        -text {New Commit} \
3346        -command do_select_commit_type \
3347        -variable selected_commit_type \
3348        -value new \
3349        -font font_ui
3350lappend disable_on_lock \
3351        [list .vpane.lower.commarea.buffer.header.new conf -state]
3352radiobutton .vpane.lower.commarea.buffer.header.amend \
3353        -text {Amend Last Commit} \
3354        -command do_select_commit_type \
3355        -variable selected_commit_type \
3356        -value amend \
3357        -font font_ui
3358lappend disable_on_lock \
3359        [list .vpane.lower.commarea.buffer.header.amend conf -state]
3360label $ui_coml \
3361        -anchor w \
3362        -justify left \
3363        -font font_ui
3364proc trace_commit_type {varname args} {
3365        global ui_coml commit_type
3366        switch -glob -- $commit_type {
3367        initial       {set txt {Initial Commit Message:}}
3368        amend         {set txt {Amended Commit Message:}}
3369        amend-initial {set txt {Amended Initial Commit Message:}}
3370        amend-merge   {set txt {Amended Merge Commit Message:}}
3371        merge         {set txt {Merge Commit Message:}}
3372        *             {set txt {Commit Message:}}
3373        }
3374        $ui_coml conf -text $txt
3375}
3376trace add variable commit_type write trace_commit_type
3377pack $ui_coml -side left -fill x
3378pack .vpane.lower.commarea.buffer.header.amend -side right
3379pack .vpane.lower.commarea.buffer.header.new -side right
3380
3381text $ui_comm -background white -borderwidth 1 \
3382        -undo true \
3383        -maxundo 20 \
3384        -autoseparators true \
3385        -relief sunken \
3386        -width 75 -height 9 -wrap none \
3387        -font font_diff \
3388        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3389scrollbar .vpane.lower.commarea.buffer.sby \
3390        -command [list $ui_comm yview]
3391pack .vpane.lower.commarea.buffer.header -side top -fill x
3392pack .vpane.lower.commarea.buffer.sby -side right -fill y
3393pack $ui_comm -side left -fill y
3394pack .vpane.lower.commarea.buffer -side left -fill y
3395
3396# -- Commit Message Buffer Context Menu
3397#
3398set ctxm .vpane.lower.commarea.buffer.ctxm
3399menu $ctxm -tearoff 0
3400$ctxm add command \
3401        -label {Cut} \
3402        -font font_ui \
3403        -command {tk_textCut $ui_comm}
3404$ctxm add command \
3405        -label {Copy} \
3406        -font font_ui \
3407        -command {tk_textCopy $ui_comm}
3408$ctxm add command \
3409        -label {Paste} \
3410        -font font_ui \
3411        -command {tk_textPaste $ui_comm}
3412$ctxm add command \
3413        -label {Delete} \
3414        -font font_ui \
3415        -command {$ui_comm delete sel.first sel.last}
3416$ctxm add separator
3417$ctxm add command \
3418        -label {Select All} \
3419        -font font_ui \
3420        -command {$ui_comm tag add sel 0.0 end}
3421$ctxm add command \
3422        -label {Copy All} \
3423        -font font_ui \
3424        -command {
3425                $ui_comm tag add sel 0.0 end
3426                tk_textCopy $ui_comm
3427                $ui_comm tag remove sel 0.0 end
3428        }
3429$ctxm add separator
3430$ctxm add command \
3431        -label {Sign Off} \
3432        -font font_ui \
3433        -command do_signoff
3434bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3435
3436# -- Diff Header
3437#
3438set current_diff {}
3439set diff_actions [list]
3440proc trace_current_diff {varname args} {
3441        global current_diff diff_actions file_states
3442        if {$current_diff eq {}} {
3443                set s {}
3444                set f {}
3445                set p {}
3446                set o disabled
3447        } else {
3448                set p $current_diff
3449                set s [mapdesc [lindex $file_states($p) 0] $p]
3450                set f {File:}
3451                set p [escape_path $p]
3452                set o normal
3453        }
3454
3455        .vpane.lower.diff.header.status configure -text $s
3456        .vpane.lower.diff.header.file configure -text $f
3457        .vpane.lower.diff.header.path configure -text $p
3458        foreach w $diff_actions {
3459                uplevel #0 $w $o
3460        }
3461}
3462trace add variable current_diff write trace_current_diff
3463
3464frame .vpane.lower.diff.header -background orange
3465label .vpane.lower.diff.header.status \
3466        -background orange \
3467        -width $max_status_desc \
3468        -anchor w \
3469        -justify left \
3470        -font font_ui
3471label .vpane.lower.diff.header.file \
3472        -background orange \
3473        -anchor w \
3474        -justify left \
3475        -font font_ui
3476label .vpane.lower.diff.header.path \
3477        -background orange \
3478        -anchor w \
3479        -justify left \
3480        -font font_ui
3481pack .vpane.lower.diff.header.status -side left
3482pack .vpane.lower.diff.header.file -side left
3483pack .vpane.lower.diff.header.path -fill x
3484set ctxm .vpane.lower.diff.header.ctxm
3485menu $ctxm -tearoff 0
3486$ctxm add command \
3487        -label {Copy} \
3488        -font font_ui \
3489        -command {
3490                clipboard clear
3491                clipboard append \
3492                        -format STRING \
3493                        -type STRING \
3494                        -- $current_diff
3495        }
3496lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3497bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3498
3499# -- Diff Body
3500#
3501frame .vpane.lower.diff.body
3502set ui_diff .vpane.lower.diff.body.t
3503text $ui_diff -background white -borderwidth 0 \
3504        -width 80 -height 15 -wrap none \
3505        -font font_diff \
3506        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3507        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3508        -state disabled
3509scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3510        -command [list $ui_diff xview]
3511scrollbar .vpane.lower.diff.body.sby -orient vertical \
3512        -command [list $ui_diff yview]
3513pack .vpane.lower.diff.body.sbx -side bottom -fill x
3514pack .vpane.lower.diff.body.sby -side right -fill y
3515pack $ui_diff -side left -fill both -expand 1
3516pack .vpane.lower.diff.header -side top -fill x
3517pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3518
3519$ui_diff tag conf d_@ -font font_diffbold
3520$ui_diff tag conf d_+  -foreground blue
3521$ui_diff tag conf d_-  -foreground red
3522$ui_diff tag conf d_++ -foreground {#00a000}
3523$ui_diff tag conf d_-- -foreground {#a000a0}
3524$ui_diff tag conf d_+- \
3525        -foreground red \
3526        -background {light goldenrod yellow}
3527$ui_diff tag conf d_-+ \
3528        -foreground blue \
3529        -background azure2
3530
3531# -- Diff Body Context Menu
3532#
3533set ctxm .vpane.lower.diff.body.ctxm
3534menu $ctxm -tearoff 0
3535$ctxm add command \
3536        -label {Copy} \
3537        -font font_ui \
3538        -command {tk_textCopy $ui_diff}
3539lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3540$ctxm add command \
3541        -label {Select All} \
3542        -font font_ui \
3543        -command {$ui_diff tag add sel 0.0 end}
3544lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3545$ctxm add command \
3546        -label {Copy All} \
3547        -font font_ui \
3548        -command {
3549                $ui_diff tag add sel 0.0 end
3550                tk_textCopy $ui_diff
3551                $ui_diff tag remove sel 0.0 end
3552        }
3553lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3554$ctxm add separator
3555$ctxm add command \
3556        -label {Decrease Font Size} \
3557        -font font_ui \
3558        -command {incr_font_size font_diff -1}
3559lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3560$ctxm add command \
3561        -label {Increase Font Size} \
3562        -font font_ui \
3563        -command {incr_font_size font_diff 1}
3564lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3565$ctxm add separator
3566$ctxm add command \
3567        -label {Show Less Context} \
3568        -font font_ui \
3569        -command {if {$repo_config(gui.diffcontext) >= 2} {
3570                incr repo_config(gui.diffcontext) -1
3571                reshow_diff
3572        }}
3573lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3574$ctxm add command \
3575        -label {Show More Context} \
3576        -font font_ui \
3577        -command {
3578                incr repo_config(gui.diffcontext)
3579                reshow_diff
3580        }
3581lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3582$ctxm add separator
3583$ctxm add command -label {Options...} \
3584        -font font_ui \
3585        -command do_options
3586bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3587
3588# -- Status Bar
3589#
3590set ui_status_value {Initializing...}
3591label .status -textvariable ui_status_value \
3592        -anchor w \
3593        -justify left \
3594        -borderwidth 1 \
3595        -relief sunken \
3596        -font font_ui
3597pack .status -anchor w -side bottom -fill x
3598
3599# -- Load geometry
3600#
3601catch {
3602set gm $repo_config(gui.geometry)
3603wm geometry . [lindex $gm 0]
3604.vpane sash place 0 \
3605        [lindex [.vpane sash coord 0] 0] \
3606        [lindex $gm 1]
3607.vpane.files sash place 0 \
3608        [lindex $gm 2] \
3609        [lindex [.vpane.files sash coord 0] 1]
3610unset gm
3611}
3612
3613# -- Key Bindings
3614#
3615bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3616bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3617bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3618bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3619bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3620bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3621bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3622bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3623bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3624bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3625bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3626
3627bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3628bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3629bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3630bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3631bind $ui_diff <$M1B-Key-v> {break}
3632bind $ui_diff <$M1B-Key-V> {break}
3633bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3634bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3635bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3636bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3637bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3638bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3639
3640bind .   <Destroy> do_quit
3641bind all <Key-F5> do_rescan
3642bind all <$M1B-Key-r> do_rescan
3643bind all <$M1B-Key-R> do_rescan
3644bind .   <$M1B-Key-s> do_signoff
3645bind .   <$M1B-Key-S> do_signoff
3646bind .   <$M1B-Key-i> do_add_all
3647bind .   <$M1B-Key-I> do_add_all
3648bind .   <$M1B-Key-Return> do_commit
3649bind all <$M1B-Key-q> do_quit
3650bind all <$M1B-Key-Q> do_quit
3651bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3652bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3653foreach i [list $ui_index $ui_workdir] {
3654        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3655        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3656        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3657}
3658unset i
3659
3660set file_lists($ui_index) [list]
3661set file_lists($ui_workdir) [list]
3662
3663set HEAD {}
3664set PARENT {}
3665set MERGE_HEAD [list]
3666set commit_type {}
3667set empty_tree {}
3668set current_branch {}
3669set current_diff {}
3670set selected_commit_type new
3671
3672wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
3673focus -force $ui_comm
3674
3675# -- Warn the user about environmental problems.  Cygwin's Tcl
3676#    does *not* pass its env array onto any processes it spawns.
3677#    This means that git processes get none of our environment.
3678#
3679if {[is_Windows]} {
3680        set ignored_env 0
3681        set suggest_user {}
3682        set msg "Possible environment issues exist.
3683
3684The following environment variables are probably
3685going to be ignored by any Git subprocess run
3686by [appname]:
3687
3688"
3689        foreach name [array names env] {
3690                switch -regexp -- $name {
3691                {^GIT_INDEX_FILE$} -
3692                {^GIT_OBJECT_DIRECTORY$} -
3693                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3694                {^GIT_DIFF_OPTS$} -
3695                {^GIT_EXTERNAL_DIFF$} -
3696                {^GIT_PAGER$} -
3697                {^GIT_TRACE$} -
3698                {^GIT_CONFIG$} -
3699                {^GIT_CONFIG_LOCAL$} -
3700                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3701                        append msg " - $name\n"
3702                        incr ignored_env
3703                }
3704                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3705                        append msg " - $name\n"
3706                        incr ignored_env
3707                        set suggest_user $name
3708                }
3709                }
3710        }
3711        if {$ignored_env > 0} {
3712                append msg "
3713This is due to a known issue with the
3714Tcl binary distributed by Cygwin."
3715
3716                if {$suggest_user ne {}} {
3717                        append msg "
3718
3719A good replacement for $suggest_user
3720is placing values for the user.name and
3721user.email settings into your personal
3722~/.gitconfig file.
3723"
3724                }
3725                warn_popup $msg
3726        }
3727        unset ignored_env msg suggest_user name
3728}
3729
3730# -- Only initialize complex UI if we are going to stay running.
3731#
3732if {!$single_commit} {
3733        load_all_remotes
3734        load_all_heads
3735
3736        populate_branch_menu .mbar.branch
3737        populate_fetch_menu .mbar.fetch
3738        populate_pull_menu .mbar.pull
3739        populate_push_menu .mbar.push
3740}
3741
3742# -- Only suggest a gc run if we are going to stay running.
3743#
3744if {!$single_commit} {
3745        set object_limit 2000
3746        if {[is_Windows]} {set object_limit 200}
3747        regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3748        if {$objects_current >= $object_limit} {
3749                if {[ask_popup \
3750                        "This repository currently has $objects_current loose objects.
3751
3752To maintain optimal performance it is strongly
3753recommended that you compress the database
3754when more than $object_limit loose objects exist.
3755
3756Compress the database now?"] eq yes} {
3757                        do_gc
3758                }
3759        }
3760        unset object_limit _junk objects_current
3761}
3762
3763lock_index begin-read
3764after 1 do_rescan