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