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