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