Andrew's git - gitweb.git/blob

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