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