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