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