git-gui / git-gui.shon commit Merge branch 'js/commit-format' (8ab3e18)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec wish "$0" -- "$@"
   4
   5set appvers {@@GITGUI_VERSION@@}
   6set copyright {
   7Copyright © 2006, 2007 Shawn Pearce, et. al.
   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}
  22set gitgui_credits {
  23Paul Mackerras
  24}
  25
  26######################################################################
  27##
  28## read only globals
  29
  30set _appname [lindex [file split $argv0] end]
  31set _gitdir {}
  32set _gitexec {}
  33set _reponame {}
  34set _iscygwin {}
  35
  36proc appname {} {
  37        global _appname
  38        return $_appname
  39}
  40
  41proc gitdir {args} {
  42        global _gitdir
  43        if {$args eq {}} {
  44                return $_gitdir
  45        }
  46        return [eval [concat [list file join $_gitdir] $args]]
  47}
  48
  49proc gitexec {args} {
  50        global _gitexec
  51        if {$_gitexec eq {}} {
  52                if {[catch {set _gitexec [git --exec-path]} err]} {
  53                        error "Git not installed?\n\n$err"
  54                }
  55        }
  56        if {$args eq {}} {
  57                return $_gitexec
  58        }
  59        return [eval [concat [list file join $_gitexec] $args]]
  60}
  61
  62proc reponame {} {
  63        global _reponame
  64        return $_reponame
  65}
  66
  67proc is_MacOSX {} {
  68        global tcl_platform tk_library
  69        if {[tk windowingsystem] eq {aqua}} {
  70                return 1
  71        }
  72        return 0
  73}
  74
  75proc is_Windows {} {
  76        global tcl_platform
  77        if {$tcl_platform(platform) eq {windows}} {
  78                return 1
  79        }
  80        return 0
  81}
  82
  83proc is_Cygwin {} {
  84        global tcl_platform _iscygwin
  85        if {$_iscygwin eq {}} {
  86                if {$tcl_platform(platform) eq {windows}} {
  87                        if {[catch {set p [exec cygpath --windir]} err]} {
  88                                set _iscygwin 0
  89                        } else {
  90                                set _iscygwin 1
  91                        }
  92                } else {
  93                        set _iscygwin 0
  94                }
  95        }
  96        return $_iscygwin
  97}
  98
  99proc is_enabled {option} {
 100        global enabled_options
 101        if {[catch {set on $enabled_options($option)}]} {return 0}
 102        return $on
 103}
 104
 105proc enable_option {option} {
 106        global enabled_options
 107        set enabled_options($option) 1
 108}
 109
 110proc disable_option {option} {
 111        global enabled_options
 112        set enabled_options($option) 0
 113}
 114
 115######################################################################
 116##
 117## config
 118
 119proc is_many_config {name} {
 120        switch -glob -- $name {
 121        remote.*.fetch -
 122        remote.*.push
 123                {return 1}
 124        *
 125                {return 0}
 126        }
 127}
 128
 129proc is_config_true {name} {
 130        global repo_config
 131        if {[catch {set v $repo_config($name)}]} {
 132                return 0
 133        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 134                return 1
 135        } else {
 136                return 0
 137        }
 138}
 139
 140proc load_config {include_global} {
 141        global repo_config global_config default_config
 142
 143        array unset global_config
 144        if {$include_global} {
 145                catch {
 146                        set fd_rc [open "| git config --global --list" r]
 147                        while {[gets $fd_rc line] >= 0} {
 148                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 149                                        if {[is_many_config $name]} {
 150                                                lappend global_config($name) $value
 151                                        } else {
 152                                                set global_config($name) $value
 153                                        }
 154                                }
 155                        }
 156                        close $fd_rc
 157                }
 158        }
 159
 160        array unset repo_config
 161        catch {
 162                set fd_rc [open "| git config --list" r]
 163                while {[gets $fd_rc line] >= 0} {
 164                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 165                                if {[is_many_config $name]} {
 166                                        lappend repo_config($name) $value
 167                                } else {
 168                                        set repo_config($name) $value
 169                                }
 170                        }
 171                }
 172                close $fd_rc
 173        }
 174
 175        foreach name [array names default_config] {
 176                if {[catch {set v $global_config($name)}]} {
 177                        set global_config($name) $default_config($name)
 178                }
 179                if {[catch {set v $repo_config($name)}]} {
 180                        set repo_config($name) $default_config($name)
 181                }
 182        }
 183}
 184
 185proc save_config {} {
 186        global default_config font_descs
 187        global repo_config global_config
 188        global repo_config_new global_config_new
 189
 190        foreach option $font_descs {
 191                set name [lindex $option 0]
 192                set font [lindex $option 1]
 193                font configure $font \
 194                        -family $global_config_new(gui.$font^^family) \
 195                        -size $global_config_new(gui.$font^^size)
 196                font configure ${font}bold \
 197                        -family $global_config_new(gui.$font^^family) \
 198                        -size $global_config_new(gui.$font^^size)
 199                set global_config_new(gui.$name) [font configure $font]
 200                unset global_config_new(gui.$font^^family)
 201                unset global_config_new(gui.$font^^size)
 202        }
 203
 204        foreach name [array names default_config] {
 205                set value $global_config_new($name)
 206                if {$value ne $global_config($name)} {
 207                        if {$value eq $default_config($name)} {
 208                                catch {git config --global --unset $name}
 209                        } else {
 210                                regsub -all "\[{}\]" $value {"} value
 211                                git config --global $name $value
 212                        }
 213                        set global_config($name) $value
 214                        if {$value eq $repo_config($name)} {
 215                                catch {git config --unset $name}
 216                                set repo_config($name) $value
 217                        }
 218                }
 219        }
 220
 221        foreach name [array names default_config] {
 222                set value $repo_config_new($name)
 223                if {$value ne $repo_config($name)} {
 224                        if {$value eq $global_config($name)} {
 225                                catch {git config --unset $name}
 226                        } else {
 227                                regsub -all "\[{}\]" $value {"} value
 228                                git config $name $value
 229                        }
 230                        set repo_config($name) $value
 231                }
 232        }
 233}
 234
 235######################################################################
 236##
 237## handy utils
 238
 239proc git {args} {
 240        return [eval exec git $args]
 241}
 242
 243proc error_popup {msg} {
 244        set title [appname]
 245        if {[reponame] ne {}} {
 246                append title " ([reponame])"
 247        }
 248        set cmd [list tk_messageBox \
 249                -icon error \
 250                -type ok \
 251                -title "$title: error" \
 252                -message $msg]
 253        if {[winfo ismapped .]} {
 254                lappend cmd -parent .
 255        }
 256        eval $cmd
 257}
 258
 259proc warn_popup {msg} {
 260        set title [appname]
 261        if {[reponame] ne {}} {
 262                append title " ([reponame])"
 263        }
 264        set cmd [list tk_messageBox \
 265                -icon warning \
 266                -type ok \
 267                -title "$title: warning" \
 268                -message $msg]
 269        if {[winfo ismapped .]} {
 270                lappend cmd -parent .
 271        }
 272        eval $cmd
 273}
 274
 275proc info_popup {msg {parent .}} {
 276        set title [appname]
 277        if {[reponame] ne {}} {
 278                append title " ([reponame])"
 279        }
 280        tk_messageBox \
 281                -parent $parent \
 282                -icon info \
 283                -type ok \
 284                -title $title \
 285                -message $msg
 286}
 287
 288proc ask_popup {msg} {
 289        set title [appname]
 290        if {[reponame] ne {}} {
 291                append title " ([reponame])"
 292        }
 293        return [tk_messageBox \
 294                -parent . \
 295                -icon question \
 296                -type yesno \
 297                -title $title \
 298                -message $msg]
 299}
 300
 301######################################################################
 302##
 303## version check
 304
 305set req_maj 1
 306set req_min 5
 307
 308if {[catch {set v [git --version]} err]} {
 309        catch {wm withdraw .}
 310        error_popup "Cannot determine Git version:
 311
 312$err
 313
 314[appname] requires Git $req_maj.$req_min or later."
 315        exit 1
 316}
 317if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
 318        if {$act_maj < $req_maj
 319                || ($act_maj == $req_maj && $act_min < $req_min)} {
 320                catch {wm withdraw .}
 321                error_popup "[appname] requires Git $req_maj.$req_min or later.
 322
 323You are using $v."
 324                exit 1
 325        }
 326} else {
 327        catch {wm withdraw .}
 328        error_popup "Cannot parse Git version string:\n\n$v"
 329        exit 1
 330}
 331unset -nocomplain v _junk act_maj act_min req_maj req_min
 332
 333######################################################################
 334##
 335## repository setup
 336
 337if {   [catch {set _gitdir $env(GIT_DIR)}]
 338        && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
 339        catch {wm withdraw .}
 340        error_popup "Cannot find the git directory:\n\n$err"
 341        exit 1
 342}
 343if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 344        catch {set _gitdir [exec cygpath --unix $_gitdir]}
 345}
 346if {![file isdirectory $_gitdir]} {
 347        catch {wm withdraw .}
 348        error_popup "Git directory not found:\n\n$_gitdir"
 349        exit 1
 350}
 351if {[lindex [file split $_gitdir] end] ne {.git}} {
 352        catch {wm withdraw .}
 353        error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 354        exit 1
 355}
 356if {[catch {cd [file dirname $_gitdir]} err]} {
 357        catch {wm withdraw .}
 358        error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 359        exit 1
 360}
 361set _reponame [lindex [file split \
 362        [file normalize [file dirname $_gitdir]]] \
 363        end]
 364
 365######################################################################
 366##
 367## global init
 368
 369set current_diff_path {}
 370set current_diff_side {}
 371set diff_actions [list]
 372set ui_status_value {Initializing...}
 373
 374set HEAD {}
 375set PARENT {}
 376set MERGE_HEAD [list]
 377set commit_type {}
 378set empty_tree {}
 379set current_branch {}
 380set current_diff_path {}
 381set selected_commit_type new
 382
 383######################################################################
 384##
 385## task management
 386
 387set rescan_active 0
 388set diff_active 0
 389set last_clicked {}
 390
 391set disable_on_lock [list]
 392set index_lock_type none
 393
 394proc lock_index {type} {
 395        global index_lock_type disable_on_lock
 396
 397        if {$index_lock_type eq {none}} {
 398                set index_lock_type $type
 399                foreach w $disable_on_lock {
 400                        uplevel #0 $w disabled
 401                }
 402                return 1
 403        } elseif {$index_lock_type eq "begin-$type"} {
 404                set index_lock_type $type
 405                return 1
 406        }
 407        return 0
 408}
 409
 410proc unlock_index {} {
 411        global index_lock_type disable_on_lock
 412
 413        set index_lock_type none
 414        foreach w $disable_on_lock {
 415                uplevel #0 $w normal
 416        }
 417}
 418
 419######################################################################
 420##
 421## status
 422
 423proc repository_state {ctvar hdvar mhvar} {
 424        global current_branch
 425        upvar $ctvar ct $hdvar hd $mhvar mh
 426
 427        set mh [list]
 428
 429        if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
 430                set current_branch {}
 431        } else {
 432                regsub ^refs/((heads|tags|remotes)/)? \
 433                        $current_branch \
 434                        {} \
 435                        current_branch
 436        }
 437
 438        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 439                set hd {}
 440                set ct initial
 441                return
 442        }
 443
 444        set merge_head [gitdir MERGE_HEAD]
 445        if {[file exists $merge_head]} {
 446                set ct merge
 447                set fd_mh [open $merge_head r]
 448                while {[gets $fd_mh line] >= 0} {
 449                        lappend mh $line
 450                }
 451                close $fd_mh
 452                return
 453        }
 454
 455        set ct normal
 456}
 457
 458proc PARENT {} {
 459        global PARENT empty_tree
 460
 461        set p [lindex $PARENT 0]
 462        if {$p ne {}} {
 463                return $p
 464        }
 465        if {$empty_tree eq {}} {
 466                set empty_tree [git mktree << {}]
 467        }
 468        return $empty_tree
 469}
 470
 471proc rescan {after {honor_trustmtime 1}} {
 472        global HEAD PARENT MERGE_HEAD commit_type
 473        global ui_index ui_workdir ui_status_value ui_comm
 474        global rescan_active file_states
 475        global repo_config
 476
 477        if {$rescan_active > 0 || ![lock_index read]} return
 478
 479        repository_state newType newHEAD newMERGE_HEAD
 480        if {[string match amend* $commit_type]
 481                && $newType eq {normal}
 482                && $newHEAD eq $HEAD} {
 483        } else {
 484                set HEAD $newHEAD
 485                set PARENT $newHEAD
 486                set MERGE_HEAD $newMERGE_HEAD
 487                set commit_type $newType
 488        }
 489
 490        array unset file_states
 491
 492        if {![$ui_comm edit modified]
 493                || [string trim [$ui_comm get 0.0 end]] eq {}} {
 494                if {[load_message GITGUI_MSG]} {
 495                } elseif {[load_message MERGE_MSG]} {
 496                } elseif {[load_message SQUASH_MSG]} {
 497                }
 498                $ui_comm edit reset
 499                $ui_comm edit modified false
 500        }
 501
 502        if {[is_enabled branch]} {
 503                load_all_heads
 504                populate_branch_menu
 505        }
 506
 507        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 508                rescan_stage2 {} $after
 509        } else {
 510                set rescan_active 1
 511                set ui_status_value {Refreshing file status...}
 512                set cmd [list git update-index]
 513                lappend cmd -q
 514                lappend cmd --unmerged
 515                lappend cmd --ignore-missing
 516                lappend cmd --refresh
 517                set fd_rf [open "| $cmd" r]
 518                fconfigure $fd_rf -blocking 0 -translation binary
 519                fileevent $fd_rf readable \
 520                        [list rescan_stage2 $fd_rf $after]
 521        }
 522}
 523
 524proc rescan_stage2 {fd after} {
 525        global ui_status_value
 526        global rescan_active buf_rdi buf_rdf buf_rlo
 527
 528        if {$fd ne {}} {
 529                read $fd
 530                if {![eof $fd]} return
 531                close $fd
 532        }
 533
 534        set ls_others [list | git ls-files --others -z \
 535                --exclude-per-directory=.gitignore]
 536        set info_exclude [gitdir info exclude]
 537        if {[file readable $info_exclude]} {
 538                lappend ls_others "--exclude-from=$info_exclude"
 539        }
 540
 541        set buf_rdi {}
 542        set buf_rdf {}
 543        set buf_rlo {}
 544
 545        set rescan_active 3
 546        set ui_status_value {Scanning for modified files ...}
 547        set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 548        set fd_df [open "| git diff-files -z" r]
 549        set fd_lo [open $ls_others r]
 550
 551        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 552        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 553        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 554        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 555        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 556        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 557}
 558
 559proc load_message {file} {
 560        global ui_comm
 561
 562        set f [gitdir $file]
 563        if {[file isfile $f]} {
 564                if {[catch {set fd [open $f r]}]} {
 565                        return 0
 566                }
 567                set content [string trim [read $fd]]
 568                close $fd
 569                regsub -all -line {[ \r\t]+$} $content {} content
 570                $ui_comm delete 0.0 end
 571                $ui_comm insert end $content
 572                return 1
 573        }
 574        return 0
 575}
 576
 577proc read_diff_index {fd after} {
 578        global buf_rdi
 579
 580        append buf_rdi [read $fd]
 581        set c 0
 582        set n [string length $buf_rdi]
 583        while {$c < $n} {
 584                set z1 [string first "\0" $buf_rdi $c]
 585                if {$z1 == -1} break
 586                incr z1
 587                set z2 [string first "\0" $buf_rdi $z1]
 588                if {$z2 == -1} break
 589
 590                incr c
 591                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 592                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 593                merge_state \
 594                        [encoding convertfrom $p] \
 595                        [lindex $i 4]? \
 596                        [list [lindex $i 0] [lindex $i 2]] \
 597                        [list]
 598                set c $z2
 599                incr c
 600        }
 601        if {$c < $n} {
 602                set buf_rdi [string range $buf_rdi $c end]
 603        } else {
 604                set buf_rdi {}
 605        }
 606
 607        rescan_done $fd buf_rdi $after
 608}
 609
 610proc read_diff_files {fd after} {
 611        global buf_rdf
 612
 613        append buf_rdf [read $fd]
 614        set c 0
 615        set n [string length $buf_rdf]
 616        while {$c < $n} {
 617                set z1 [string first "\0" $buf_rdf $c]
 618                if {$z1 == -1} break
 619                incr z1
 620                set z2 [string first "\0" $buf_rdf $z1]
 621                if {$z2 == -1} break
 622
 623                incr c
 624                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 625                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 626                merge_state \
 627                        [encoding convertfrom $p] \
 628                        ?[lindex $i 4] \
 629                        [list] \
 630                        [list [lindex $i 0] [lindex $i 2]]
 631                set c $z2
 632                incr c
 633        }
 634        if {$c < $n} {
 635                set buf_rdf [string range $buf_rdf $c end]
 636        } else {
 637                set buf_rdf {}
 638        }
 639
 640        rescan_done $fd buf_rdf $after
 641}
 642
 643proc read_ls_others {fd after} {
 644        global buf_rlo
 645
 646        append buf_rlo [read $fd]
 647        set pck [split $buf_rlo "\0"]
 648        set buf_rlo [lindex $pck end]
 649        foreach p [lrange $pck 0 end-1] {
 650                merge_state [encoding convertfrom $p] ?O
 651        }
 652        rescan_done $fd buf_rlo $after
 653}
 654
 655proc rescan_done {fd buf after} {
 656        global rescan_active
 657        global file_states repo_config
 658        upvar $buf to_clear
 659
 660        if {![eof $fd]} return
 661        set to_clear {}
 662        close $fd
 663        if {[incr rescan_active -1] > 0} return
 664
 665        prune_selection
 666        unlock_index
 667        display_all_files
 668        reshow_diff
 669        uplevel #0 $after
 670}
 671
 672proc prune_selection {} {
 673        global file_states selected_paths
 674
 675        foreach path [array names selected_paths] {
 676                if {[catch {set still_here $file_states($path)}]} {
 677                        unset selected_paths($path)
 678                }
 679        }
 680}
 681
 682######################################################################
 683##
 684## diff
 685
 686proc clear_diff {} {
 687        global ui_diff current_diff_path current_diff_header
 688        global ui_index ui_workdir
 689
 690        $ui_diff conf -state normal
 691        $ui_diff delete 0.0 end
 692        $ui_diff conf -state disabled
 693
 694        set current_diff_path {}
 695        set current_diff_header {}
 696
 697        $ui_index tag remove in_diff 0.0 end
 698        $ui_workdir tag remove in_diff 0.0 end
 699}
 700
 701proc reshow_diff {} {
 702        global ui_status_value file_states file_lists
 703        global current_diff_path current_diff_side
 704
 705        set p $current_diff_path
 706        if {$p eq {}} {
 707                # No diff is being shown.
 708        } elseif {$current_diff_side eq {}
 709                || [catch {set s $file_states($p)}]
 710                || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 711                clear_diff
 712        } else {
 713                show_diff $p $current_diff_side
 714        }
 715}
 716
 717proc handle_empty_diff {} {
 718        global current_diff_path file_states file_lists
 719
 720        set path $current_diff_path
 721        set s $file_states($path)
 722        if {[lindex $s 0] ne {_M}} return
 723
 724        info_popup "No differences detected.
 725
 726[short_path $path] has no changes.
 727
 728The modification date of this file was updated
 729by another application, but the content within
 730the file was not changed.
 731
 732A rescan will be automatically started to find
 733other files which may have the same state."
 734
 735        clear_diff
 736        display_file $path __
 737        rescan {set ui_status_value {Ready.}} 0
 738}
 739
 740proc show_diff {path w {lno {}}} {
 741        global file_states file_lists
 742        global is_3way_diff diff_active repo_config
 743        global ui_diff ui_status_value ui_index ui_workdir
 744        global current_diff_path current_diff_side current_diff_header
 745
 746        if {$diff_active || ![lock_index read]} return
 747
 748        clear_diff
 749        if {$lno == {}} {
 750                set lno [lsearch -sorted -exact $file_lists($w) $path]
 751                if {$lno >= 0} {
 752                        incr lno
 753                }
 754        }
 755        if {$lno >= 1} {
 756                $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 757        }
 758
 759        set s $file_states($path)
 760        set m [lindex $s 0]
 761        set is_3way_diff 0
 762        set diff_active 1
 763        set current_diff_path $path
 764        set current_diff_side $w
 765        set current_diff_header {}
 766        set ui_status_value "Loading diff of [escape_path $path]..."
 767
 768        # - Git won't give us the diff, there's nothing to compare to!
 769        #
 770        if {$m eq {_O}} {
 771                set max_sz [expr {128 * 1024}]
 772                if {[catch {
 773                                set fd [open $path r]
 774                                set content [read $fd $max_sz]
 775                                close $fd
 776                                set sz [file size $path]
 777                        } err ]} {
 778                        set diff_active 0
 779                        unlock_index
 780                        set ui_status_value "Unable to display [escape_path $path]"
 781                        error_popup "Error loading file:\n\n$err"
 782                        return
 783                }
 784                $ui_diff conf -state normal
 785                if {![catch {set type [exec file $path]}]} {
 786                        set n [string length $path]
 787                        if {[string equal -length $n $path $type]} {
 788                                set type [string range $type $n end]
 789                                regsub {^:?\s*} $type {} type
 790                        }
 791                        $ui_diff insert end "* $type\n" d_@
 792                }
 793                if {[string first "\0" $content] != -1} {
 794                        $ui_diff insert end \
 795                                "* Binary file (not showing content)." \
 796                                d_@
 797                } else {
 798                        if {$sz > $max_sz} {
 799                                $ui_diff insert end \
 800"* Untracked file is $sz bytes.
 801* Showing only first $max_sz bytes.
 802" d_@
 803                        }
 804                        $ui_diff insert end $content
 805                        if {$sz > $max_sz} {
 806                                $ui_diff insert end "
 807* Untracked file clipped here by [appname].
 808* To see the entire file, use an external editor.
 809" d_@
 810                        }
 811                }
 812                $ui_diff conf -state disabled
 813                set diff_active 0
 814                unlock_index
 815                set ui_status_value {Ready.}
 816                return
 817        }
 818
 819        set cmd [list | git]
 820        if {$w eq $ui_index} {
 821                lappend cmd diff-index
 822                lappend cmd --cached
 823        } elseif {$w eq $ui_workdir} {
 824                if {[string index $m 0] eq {U}} {
 825                        lappend cmd diff
 826                } else {
 827                        lappend cmd diff-files
 828                }
 829        }
 830
 831        lappend cmd -p
 832        lappend cmd --no-color
 833        if {$repo_config(gui.diffcontext) > 0} {
 834                lappend cmd "-U$repo_config(gui.diffcontext)"
 835        }
 836        if {$w eq $ui_index} {
 837                lappend cmd [PARENT]
 838        }
 839        lappend cmd --
 840        lappend cmd $path
 841
 842        if {[catch {set fd [open $cmd r]} err]} {
 843                set diff_active 0
 844                unlock_index
 845                set ui_status_value "Unable to display [escape_path $path]"
 846                error_popup "Error loading diff:\n\n$err"
 847                return
 848        }
 849
 850        fconfigure $fd \
 851                -blocking 0 \
 852                -encoding binary \
 853                -translation binary
 854        fileevent $fd readable [list read_diff $fd]
 855}
 856
 857proc read_diff {fd} {
 858        global ui_diff ui_status_value diff_active
 859        global is_3way_diff current_diff_header
 860
 861        $ui_diff conf -state normal
 862        while {[gets $fd line] >= 0} {
 863                # -- Cleanup uninteresting diff header lines.
 864                #
 865                if {   [string match {diff --git *}      $line]
 866                        || [string match {diff --cc *}       $line]
 867                        || [string match {diff --combined *} $line]
 868                        || [string match {--- *}             $line]
 869                        || [string match {+++ *}             $line]} {
 870                        append current_diff_header $line "\n"
 871                        continue
 872                }
 873                if {[string match {index *} $line]} continue
 874                if {$line eq {deleted file mode 120000}} {
 875                        set line "deleted symlink"
 876                }
 877
 878                # -- Automatically detect if this is a 3 way diff.
 879                #
 880                if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 881
 882                if {[string match {mode *} $line]
 883                        || [string match {new file *} $line]
 884                        || [string match {deleted file *} $line]
 885                        || [string match {Binary files * and * differ} $line]
 886                        || $line eq {\ No newline at end of file}
 887                        || [regexp {^\* Unmerged path } $line]} {
 888                        set tags {}
 889                } elseif {$is_3way_diff} {
 890                        set op [string range $line 0 1]
 891                        switch -- $op {
 892                        {  } {set tags {}}
 893                        {@@} {set tags d_@}
 894                        { +} {set tags d_s+}
 895                        { -} {set tags d_s-}
 896                        {+ } {set tags d_+s}
 897                        {- } {set tags d_-s}
 898                        {--} {set tags d_--}
 899                        {++} {
 900                                if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 901                                        set line [string replace $line 0 1 {  }]
 902                                        set tags d$op
 903                                } else {
 904                                        set tags d_++
 905                                }
 906                        }
 907                        default {
 908                                puts "error: Unhandled 3 way diff marker: {$op}"
 909                                set tags {}
 910                        }
 911                        }
 912                } else {
 913                        set op [string index $line 0]
 914                        switch -- $op {
 915                        { } {set tags {}}
 916                        {@} {set tags d_@}
 917                        {-} {set tags d_-}
 918                        {+} {
 919                                if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 920                                        set line [string replace $line 0 0 { }]
 921                                        set tags d$op
 922                                } else {
 923                                        set tags d_+
 924                                }
 925                        }
 926                        default {
 927                                puts "error: Unhandled 2 way diff marker: {$op}"
 928                                set tags {}
 929                        }
 930                        }
 931                }
 932                $ui_diff insert end $line $tags
 933                if {[string index $line end] eq "\r"} {
 934                        $ui_diff tag add d_cr {end - 2c}
 935                }
 936                $ui_diff insert end "\n" $tags
 937        }
 938        $ui_diff conf -state disabled
 939
 940        if {[eof $fd]} {
 941                close $fd
 942                set diff_active 0
 943                unlock_index
 944                set ui_status_value {Ready.}
 945
 946                if {[$ui_diff index end] eq {2.0}} {
 947                        handle_empty_diff
 948                }
 949        }
 950}
 951
 952proc apply_hunk {x y} {
 953        global current_diff_path current_diff_header current_diff_side
 954        global ui_diff ui_index file_states
 955
 956        if {$current_diff_path eq {} || $current_diff_header eq {}} return
 957        if {![lock_index apply_hunk]} return
 958
 959        set apply_cmd {git apply --cached --whitespace=nowarn}
 960        set mi [lindex $file_states($current_diff_path) 0]
 961        if {$current_diff_side eq $ui_index} {
 962                set mode unstage
 963                lappend apply_cmd --reverse
 964                if {[string index $mi 0] ne {M}} {
 965                        unlock_index
 966                        return
 967                }
 968        } else {
 969                set mode stage
 970                if {[string index $mi 1] ne {M}} {
 971                        unlock_index
 972                        return
 973                }
 974        }
 975
 976        set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 977        set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 978        if {$s_lno eq {}} {
 979                unlock_index
 980                return
 981        }
 982
 983        set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 984        if {$e_lno eq {}} {
 985                set e_lno end
 986        }
 987
 988        if {[catch {
 989                set p [open "| $apply_cmd" w]
 990                fconfigure $p -translation binary -encoding binary
 991                puts -nonewline $p $current_diff_header
 992                puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 993                close $p} err]} {
 994                error_popup "Failed to $mode selected hunk.\n\n$err"
 995                unlock_index
 996                return
 997        }
 998
 999        $ui_diff conf -state normal
1000        $ui_diff delete $s_lno $e_lno
1001        $ui_diff conf -state disabled
1002
1003        if {[$ui_diff get 1.0 end] eq "\n"} {
1004                set o _
1005        } else {
1006                set o ?
1007        }
1008
1009        if {$current_diff_side eq $ui_index} {
1010                set mi ${o}M
1011        } elseif {[string index $mi 0] eq {_}} {
1012                set mi M$o
1013        } else {
1014                set mi ?$o
1015        }
1016        unlock_index
1017        display_file $current_diff_path $mi
1018        if {$o eq {_}} {
1019                clear_diff
1020        }
1021}
1022
1023######################################################################
1024##
1025## commit
1026
1027proc load_last_commit {} {
1028        global HEAD PARENT MERGE_HEAD commit_type ui_comm
1029        global repo_config
1030
1031        if {[llength $PARENT] == 0} {
1032                error_popup {There is nothing to amend.
1033
1034You are about to create the initial commit.
1035There is no commit before this to amend.
1036}
1037                return
1038        }
1039
1040        repository_state curType curHEAD curMERGE_HEAD
1041        if {$curType eq {merge}} {
1042                error_popup {Cannot amend while merging.
1043
1044You are currently in the middle of a merge that
1045has not been fully completed.  You cannot amend
1046the prior commit unless you first abort the
1047current merge activity.
1048}
1049                return
1050        }
1051
1052        set msg {}
1053        set parents [list]
1054        if {[catch {
1055                        set fd [open "| git cat-file commit $curHEAD" r]
1056                        fconfigure $fd -encoding binary -translation lf
1057                        if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1058                                set enc utf-8
1059                        }
1060                        while {[gets $fd line] > 0} {
1061                                if {[string match {parent *} $line]} {
1062                                        lappend parents [string range $line 7 end]
1063                                } elseif {[string match {encoding *} $line]} {
1064                                        set enc [string tolower [string range $line 9 end]]
1065                                }
1066                        }
1067                        fconfigure $fd -encoding $enc
1068                        set msg [string trim [read $fd]]
1069                        close $fd
1070                } err]} {
1071                error_popup "Error loading commit data for amend:\n\n$err"
1072                return
1073        }
1074
1075        set HEAD $curHEAD
1076        set PARENT $parents
1077        set MERGE_HEAD [list]
1078        switch -- [llength $parents] {
1079        0       {set commit_type amend-initial}
1080        1       {set commit_type amend}
1081        default {set commit_type amend-merge}
1082        }
1083
1084        $ui_comm delete 0.0 end
1085        $ui_comm insert end $msg
1086        $ui_comm edit reset
1087        $ui_comm edit modified false
1088        rescan {set ui_status_value {Ready.}}
1089}
1090
1091proc create_new_commit {} {
1092        global commit_type ui_comm
1093
1094        set commit_type normal
1095        $ui_comm delete 0.0 end
1096        $ui_comm edit reset
1097        $ui_comm edit modified false
1098        rescan {set ui_status_value {Ready.}}
1099}
1100
1101set GIT_COMMITTER_IDENT {}
1102
1103proc committer_ident {} {
1104        global GIT_COMMITTER_IDENT
1105
1106        if {$GIT_COMMITTER_IDENT eq {}} {
1107                if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1108                        error_popup "Unable to obtain your identity:\n\n$err"
1109                        return {}
1110                }
1111                if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1112                        $me me GIT_COMMITTER_IDENT]} {
1113                        error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1114                        return {}
1115                }
1116        }
1117
1118        return $GIT_COMMITTER_IDENT
1119}
1120
1121proc commit_tree {} {
1122        global HEAD commit_type file_states ui_comm repo_config
1123        global ui_status_value pch_error
1124
1125        if {[committer_ident] eq {}} return
1126        if {![lock_index update]} return
1127
1128        # -- Our in memory state should match the repository.
1129        #
1130        repository_state curType curHEAD curMERGE_HEAD
1131        if {[string match amend* $commit_type]
1132                && $curType eq {normal}
1133                && $curHEAD eq $HEAD} {
1134        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1135                info_popup {Last scanned state does not match repository state.
1136
1137Another Git program has modified this repository
1138since the last scan.  A rescan must be performed
1139before another commit can be created.
1140
1141The rescan will be automatically started now.
1142}
1143                unlock_index
1144                rescan {set ui_status_value {Ready.}}
1145                return
1146        }
1147
1148        # -- At least one file should differ in the index.
1149        #
1150        set files_ready 0
1151        foreach path [array names file_states] {
1152                switch -glob -- [lindex $file_states($path) 0] {
1153                _? {continue}
1154                A? -
1155                D? -
1156                M? {set files_ready 1}
1157                U? {
1158                        error_popup "Unmerged files cannot be committed.
1159
1160File [short_path $path] has merge conflicts.
1161You must resolve them and add the file before committing.
1162"
1163                        unlock_index
1164                        return
1165                }
1166                default {
1167                        error_popup "Unknown file state [lindex $s 0] detected.
1168
1169File [short_path $path] cannot be committed by this program.
1170"
1171                }
1172                }
1173        }
1174        if {!$files_ready} {
1175                info_popup {No changes to commit.
1176
1177You must add at least 1 file before you can commit.
1178}
1179                unlock_index
1180                return
1181        }
1182
1183        # -- A message is required.
1184        #
1185        set msg [string trim [$ui_comm get 1.0 end]]
1186        regsub -all -line {[ \t\r]+$} $msg {} msg
1187        if {$msg eq {}} {
1188                error_popup {Please supply a commit message.
1189
1190A good commit message has the following format:
1191
1192- First line: Describe in one sentance what you did.
1193- Second line: Blank
1194- Remaining lines: Describe why this change is good.
1195}
1196                unlock_index
1197                return
1198        }
1199
1200        # -- Run the pre-commit hook.
1201        #
1202        set pchook [gitdir hooks pre-commit]
1203
1204        # On Cygwin [file executable] might lie so we need to ask
1205        # the shell if the hook is executable.  Yes that's annoying.
1206        #
1207        if {[is_Cygwin] && [file isfile $pchook]} {
1208                set pchook [list sh -c [concat \
1209                        "if test -x \"$pchook\";" \
1210                        "then exec \"$pchook\" 2>&1;" \
1211                        "fi"]]
1212        } elseif {[file executable $pchook]} {
1213                set pchook [list $pchook |& cat]
1214        } else {
1215                commit_writetree $curHEAD $msg
1216                return
1217        }
1218
1219        set ui_status_value {Calling pre-commit hook...}
1220        set pch_error {}
1221        set fd_ph [open "| $pchook" r]
1222        fconfigure $fd_ph -blocking 0 -translation binary
1223        fileevent $fd_ph readable \
1224                [list commit_prehook_wait $fd_ph $curHEAD $msg]
1225}
1226
1227proc commit_prehook_wait {fd_ph curHEAD msg} {
1228        global pch_error ui_status_value
1229
1230        append pch_error [read $fd_ph]
1231        fconfigure $fd_ph -blocking 1
1232        if {[eof $fd_ph]} {
1233                if {[catch {close $fd_ph}]} {
1234                        set ui_status_value {Commit declined by pre-commit hook.}
1235                        hook_failed_popup pre-commit $pch_error
1236                        unlock_index
1237                } else {
1238                        commit_writetree $curHEAD $msg
1239                }
1240                set pch_error {}
1241                return
1242        }
1243        fconfigure $fd_ph -blocking 0
1244}
1245
1246proc commit_writetree {curHEAD msg} {
1247        global ui_status_value
1248
1249        set ui_status_value {Committing changes...}
1250        set fd_wt [open "| git write-tree" r]
1251        fileevent $fd_wt readable \
1252                [list commit_committree $fd_wt $curHEAD $msg]
1253}
1254
1255proc commit_committree {fd_wt curHEAD msg} {
1256        global HEAD PARENT MERGE_HEAD commit_type
1257        global all_heads current_branch
1258        global ui_status_value ui_comm selected_commit_type
1259        global file_states selected_paths rescan_active
1260        global repo_config
1261
1262        gets $fd_wt tree_id
1263        if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1264                error_popup "write-tree failed:\n\n$err"
1265                set ui_status_value {Commit failed.}
1266                unlock_index
1267                return
1268        }
1269
1270        # -- Build the message.
1271        #
1272        set msg_p [gitdir COMMIT_EDITMSG]
1273        set msg_wt [open $msg_p w]
1274        if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1275                set enc utf-8
1276        }
1277        fconfigure $msg_wt -encoding $enc -translation binary
1278        puts -nonewline $msg_wt $msg
1279        close $msg_wt
1280
1281        # -- Create the commit.
1282        #
1283        set cmd [list git commit-tree $tree_id]
1284        set parents [concat $PARENT $MERGE_HEAD]
1285        if {[llength $parents] > 0} {
1286                foreach p $parents {
1287                        lappend cmd -p $p
1288                }
1289        } else {
1290                # git commit-tree writes to stderr during initial commit.
1291                lappend cmd 2>/dev/null
1292        }
1293        lappend cmd <$msg_p
1294        if {[catch {set cmt_id [eval exec $cmd]} err]} {
1295                error_popup "commit-tree failed:\n\n$err"
1296                set ui_status_value {Commit failed.}
1297                unlock_index
1298                return
1299        }
1300
1301        # -- Update the HEAD ref.
1302        #
1303        set reflogm commit
1304        if {$commit_type ne {normal}} {
1305                append reflogm " ($commit_type)"
1306        }
1307        set i [string first "\n" $msg]
1308        if {$i >= 0} {
1309                append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1310        } else {
1311                append reflogm {: } $msg
1312        }
1313        set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1314        if {[catch {eval exec $cmd} err]} {
1315                error_popup "update-ref failed:\n\n$err"
1316                set ui_status_value {Commit failed.}
1317                unlock_index
1318                return
1319        }
1320
1321        # -- Cleanup after ourselves.
1322        #
1323        catch {file delete $msg_p}
1324        catch {file delete [gitdir MERGE_HEAD]}
1325        catch {file delete [gitdir MERGE_MSG]}
1326        catch {file delete [gitdir SQUASH_MSG]}
1327        catch {file delete [gitdir GITGUI_MSG]}
1328
1329        # -- Let rerere do its thing.
1330        #
1331        if {[file isdirectory [gitdir rr-cache]]} {
1332                catch {git rerere}
1333        }
1334
1335        # -- Run the post-commit hook.
1336        #
1337        set pchook [gitdir hooks post-commit]
1338        if {[is_Cygwin] && [file isfile $pchook]} {
1339                set pchook [list sh -c [concat \
1340                        "if test -x \"$pchook\";" \
1341                        "then exec \"$pchook\";" \
1342                        "fi"]]
1343        } elseif {![file executable $pchook]} {
1344                set pchook {}
1345        }
1346        if {$pchook ne {}} {
1347                catch {exec $pchook &}
1348        }
1349
1350        $ui_comm delete 0.0 end
1351        $ui_comm edit reset
1352        $ui_comm edit modified false
1353
1354        if {[is_enabled singlecommit]} do_quit
1355
1356        # -- Make sure our current branch exists.
1357        #
1358        if {$commit_type eq {initial}} {
1359                lappend all_heads $current_branch
1360                set all_heads [lsort -unique $all_heads]
1361                populate_branch_menu
1362        }
1363
1364        # -- Update in memory status
1365        #
1366        set selected_commit_type new
1367        set commit_type normal
1368        set HEAD $cmt_id
1369        set PARENT $cmt_id
1370        set MERGE_HEAD [list]
1371
1372        foreach path [array names file_states] {
1373                set s $file_states($path)
1374                set m [lindex $s 0]
1375                switch -glob -- $m {
1376                _O -
1377                _M -
1378                _D {continue}
1379                __ -
1380                A_ -
1381                M_ -
1382                D_ {
1383                        unset file_states($path)
1384                        catch {unset selected_paths($path)}
1385                }
1386                DO {
1387                        set file_states($path) [list _O [lindex $s 1] {} {}]
1388                }
1389                AM -
1390                AD -
1391                MM -
1392                MD {
1393                        set file_states($path) [list \
1394                                _[string index $m 1] \
1395                                [lindex $s 1] \
1396                                [lindex $s 3] \
1397                                {}]
1398                }
1399                }
1400        }
1401
1402        display_all_files
1403        unlock_index
1404        reshow_diff
1405        set ui_status_value \
1406                "Changes committed as [string range $cmt_id 0 7]."
1407}
1408
1409######################################################################
1410##
1411## fetch push
1412
1413proc fetch_from {remote} {
1414        set w [new_console \
1415                "fetch $remote" \
1416                "Fetching new changes from $remote"]
1417        set cmd [list git fetch]
1418        lappend cmd $remote
1419        console_exec $w $cmd console_done
1420}
1421
1422proc push_to {remote} {
1423        set w [new_console \
1424                "push $remote" \
1425                "Pushing changes to $remote"]
1426        set cmd [list git push]
1427        lappend cmd -v
1428        lappend cmd $remote
1429        console_exec $w $cmd console_done
1430}
1431
1432######################################################################
1433##
1434## ui helpers
1435
1436proc mapicon {w state path} {
1437        global all_icons
1438
1439        if {[catch {set r $all_icons($state$w)}]} {
1440                puts "error: no icon for $w state={$state} $path"
1441                return file_plain
1442        }
1443        return $r
1444}
1445
1446proc mapdesc {state path} {
1447        global all_descs
1448
1449        if {[catch {set r $all_descs($state)}]} {
1450                puts "error: no desc for state={$state} $path"
1451                return $state
1452        }
1453        return $r
1454}
1455
1456proc escape_path {path} {
1457        regsub -all {\\} $path "\\\\" path
1458        regsub -all "\n" $path "\\n" path
1459        return $path
1460}
1461
1462proc short_path {path} {
1463        return [escape_path [lindex [file split $path] end]]
1464}
1465
1466set next_icon_id 0
1467set null_sha1 [string repeat 0 40]
1468
1469proc merge_state {path new_state {head_info {}} {index_info {}}} {
1470        global file_states next_icon_id null_sha1
1471
1472        set s0 [string index $new_state 0]
1473        set s1 [string index $new_state 1]
1474
1475        if {[catch {set info $file_states($path)}]} {
1476                set state __
1477                set icon n[incr next_icon_id]
1478        } else {
1479                set state [lindex $info 0]
1480                set icon [lindex $info 1]
1481                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1482                if {$index_info eq {}} {set index_info [lindex $info 3]}
1483        }
1484
1485        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1486        elseif {$s0 eq {_}} {set s0 _}
1487
1488        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1489        elseif {$s1 eq {_}} {set s1 _}
1490
1491        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1492                set head_info [list 0 $null_sha1]
1493        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1494                && $head_info eq {}} {
1495                set head_info $index_info
1496        }
1497
1498        set file_states($path) [list $s0$s1 $icon \
1499                $head_info $index_info \
1500                ]
1501        return $state
1502}
1503
1504proc display_file_helper {w path icon_name old_m new_m} {
1505        global file_lists
1506
1507        if {$new_m eq {_}} {
1508                set lno [lsearch -sorted -exact $file_lists($w) $path]
1509                if {$lno >= 0} {
1510                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1511                        incr lno
1512                        $w conf -state normal
1513                        $w delete $lno.0 [expr {$lno + 1}].0
1514                        $w conf -state disabled
1515                }
1516        } elseif {$old_m eq {_} && $new_m ne {_}} {
1517                lappend file_lists($w) $path
1518                set file_lists($w) [lsort -unique $file_lists($w)]
1519                set lno [lsearch -sorted -exact $file_lists($w) $path]
1520                incr lno
1521                $w conf -state normal
1522                $w image create $lno.0 \
1523                        -align center -padx 5 -pady 1 \
1524                        -name $icon_name \
1525                        -image [mapicon $w $new_m $path]
1526                $w insert $lno.1 "[escape_path $path]\n"
1527                $w conf -state disabled
1528        } elseif {$old_m ne $new_m} {
1529                $w conf -state normal
1530                $w image conf $icon_name -image [mapicon $w $new_m $path]
1531                $w conf -state disabled
1532        }
1533}
1534
1535proc display_file {path state} {
1536        global file_states selected_paths
1537        global ui_index ui_workdir
1538
1539        set old_m [merge_state $path $state]
1540        set s $file_states($path)
1541        set new_m [lindex $s 0]
1542        set icon_name [lindex $s 1]
1543
1544        set o [string index $old_m 0]
1545        set n [string index $new_m 0]
1546        if {$o eq {U}} {
1547                set o _
1548        }
1549        if {$n eq {U}} {
1550                set n _
1551        }
1552        display_file_helper     $ui_index $path $icon_name $o $n
1553
1554        if {[string index $old_m 0] eq {U}} {
1555                set o U
1556        } else {
1557                set o [string index $old_m 1]
1558        }
1559        if {[string index $new_m 0] eq {U}} {
1560                set n U
1561        } else {
1562                set n [string index $new_m 1]
1563        }
1564        display_file_helper     $ui_workdir $path $icon_name $o $n
1565
1566        if {$new_m eq {__}} {
1567                unset file_states($path)
1568                catch {unset selected_paths($path)}
1569        }
1570}
1571
1572proc display_all_files_helper {w path icon_name m} {
1573        global file_lists
1574
1575        lappend file_lists($w) $path
1576        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1577        $w image create end \
1578                -align center -padx 5 -pady 1 \
1579                -name $icon_name \
1580                -image [mapicon $w $m $path]
1581        $w insert end "[escape_path $path]\n"
1582}
1583
1584proc display_all_files {} {
1585        global ui_index ui_workdir
1586        global file_states file_lists
1587        global last_clicked
1588
1589        $ui_index conf -state normal
1590        $ui_workdir conf -state normal
1591
1592        $ui_index delete 0.0 end
1593        $ui_workdir delete 0.0 end
1594        set last_clicked {}
1595
1596        set file_lists($ui_index) [list]
1597        set file_lists($ui_workdir) [list]
1598
1599        foreach path [lsort [array names file_states]] {
1600                set s $file_states($path)
1601                set m [lindex $s 0]
1602                set icon_name [lindex $s 1]
1603
1604                set s [string index $m 0]
1605                if {$s ne {U} && $s ne {_}} {
1606                        display_all_files_helper $ui_index $path \
1607                                $icon_name $s
1608                }
1609
1610                if {[string index $m 0] eq {U}} {
1611                        set s U
1612                } else {
1613                        set s [string index $m 1]
1614                }
1615                if {$s ne {_}} {
1616                        display_all_files_helper $ui_workdir $path \
1617                                $icon_name $s
1618                }
1619        }
1620
1621        $ui_index conf -state disabled
1622        $ui_workdir conf -state disabled
1623}
1624
1625proc update_indexinfo {msg pathList after} {
1626        global update_index_cp ui_status_value
1627
1628        if {![lock_index update]} return
1629
1630        set update_index_cp 0
1631        set pathList [lsort $pathList]
1632        set totalCnt [llength $pathList]
1633        set batch [expr {int($totalCnt * .01) + 1}]
1634        if {$batch > 25} {set batch 25}
1635
1636        set ui_status_value [format \
1637                "$msg... %i/%i files (%.2f%%)" \
1638                $update_index_cp \
1639                $totalCnt \
1640                0.0]
1641        set fd [open "| git update-index -z --index-info" w]
1642        fconfigure $fd \
1643                -blocking 0 \
1644                -buffering full \
1645                -buffersize 512 \
1646                -encoding binary \
1647                -translation binary
1648        fileevent $fd writable [list \
1649                write_update_indexinfo \
1650                $fd \
1651                $pathList \
1652                $totalCnt \
1653                $batch \
1654                $msg \
1655                $after \
1656                ]
1657}
1658
1659proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1660        global update_index_cp ui_status_value
1661        global file_states current_diff_path
1662
1663        if {$update_index_cp >= $totalCnt} {
1664                close $fd
1665                unlock_index
1666                uplevel #0 $after
1667                return
1668        }
1669
1670        for {set i $batch} \
1671                {$update_index_cp < $totalCnt && $i > 0} \
1672                {incr i -1} {
1673                set path [lindex $pathList $update_index_cp]
1674                incr update_index_cp
1675
1676                set s $file_states($path)
1677                switch -glob -- [lindex $s 0] {
1678                A? {set new _O}
1679                M? {set new _M}
1680                D_ {set new _D}
1681                D? {set new _?}
1682                ?? {continue}
1683                }
1684                set info [lindex $s 2]
1685                if {$info eq {}} continue
1686
1687                puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1688                display_file $path $new
1689        }
1690
1691        set ui_status_value [format \
1692                "$msg... %i/%i files (%.2f%%)" \
1693                $update_index_cp \
1694                $totalCnt \
1695                [expr {100.0 * $update_index_cp / $totalCnt}]]
1696}
1697
1698proc update_index {msg pathList after} {
1699        global update_index_cp ui_status_value
1700
1701        if {![lock_index update]} return
1702
1703        set update_index_cp 0
1704        set pathList [lsort $pathList]
1705        set totalCnt [llength $pathList]
1706        set batch [expr {int($totalCnt * .01) + 1}]
1707        if {$batch > 25} {set batch 25}
1708
1709        set ui_status_value [format \
1710                "$msg... %i/%i files (%.2f%%)" \
1711                $update_index_cp \
1712                $totalCnt \
1713                0.0]
1714        set fd [open "| git update-index --add --remove -z --stdin" w]
1715        fconfigure $fd \
1716                -blocking 0 \
1717                -buffering full \
1718                -buffersize 512 \
1719                -encoding binary \
1720                -translation binary
1721        fileevent $fd writable [list \
1722                write_update_index \
1723                $fd \
1724                $pathList \
1725                $totalCnt \
1726                $batch \
1727                $msg \
1728                $after \
1729                ]
1730}
1731
1732proc write_update_index {fd pathList totalCnt batch msg after} {
1733        global update_index_cp ui_status_value
1734        global file_states current_diff_path
1735
1736        if {$update_index_cp >= $totalCnt} {
1737                close $fd
1738                unlock_index
1739                uplevel #0 $after
1740                return
1741        }
1742
1743        for {set i $batch} \
1744                {$update_index_cp < $totalCnt && $i > 0} \
1745                {incr i -1} {
1746                set path [lindex $pathList $update_index_cp]
1747                incr update_index_cp
1748
1749                switch -glob -- [lindex $file_states($path) 0] {
1750                AD {set new __}
1751                ?D {set new D_}
1752                _O -
1753                AM {set new A_}
1754                U? {
1755                        if {[file exists $path]} {
1756                                set new M_
1757                        } else {
1758                                set new D_
1759                        }
1760                }
1761                ?M {set new M_}
1762                ?? {continue}
1763                }
1764                puts -nonewline $fd "[encoding convertto $path]\0"
1765                display_file $path $new
1766        }
1767
1768        set ui_status_value [format \
1769                "$msg... %i/%i files (%.2f%%)" \
1770                $update_index_cp \
1771                $totalCnt \
1772                [expr {100.0 * $update_index_cp / $totalCnt}]]
1773}
1774
1775proc checkout_index {msg pathList after} {
1776        global update_index_cp ui_status_value
1777
1778        if {![lock_index update]} return
1779
1780        set update_index_cp 0
1781        set pathList [lsort $pathList]
1782        set totalCnt [llength $pathList]
1783        set batch [expr {int($totalCnt * .01) + 1}]
1784        if {$batch > 25} {set batch 25}
1785
1786        set ui_status_value [format \
1787                "$msg... %i/%i files (%.2f%%)" \
1788                $update_index_cp \
1789                $totalCnt \
1790                0.0]
1791        set cmd [list git checkout-index]
1792        lappend cmd --index
1793        lappend cmd --quiet
1794        lappend cmd --force
1795        lappend cmd -z
1796        lappend cmd --stdin
1797        set fd [open "| $cmd " w]
1798        fconfigure $fd \
1799                -blocking 0 \
1800                -buffering full \
1801                -buffersize 512 \
1802                -encoding binary \
1803                -translation binary
1804        fileevent $fd writable [list \
1805                write_checkout_index \
1806                $fd \
1807                $pathList \
1808                $totalCnt \
1809                $batch \
1810                $msg \
1811                $after \
1812                ]
1813}
1814
1815proc write_checkout_index {fd pathList totalCnt batch msg after} {
1816        global update_index_cp ui_status_value
1817        global file_states current_diff_path
1818
1819        if {$update_index_cp >= $totalCnt} {
1820                close $fd
1821                unlock_index
1822                uplevel #0 $after
1823                return
1824        }
1825
1826        for {set i $batch} \
1827                {$update_index_cp < $totalCnt && $i > 0} \
1828                {incr i -1} {
1829                set path [lindex $pathList $update_index_cp]
1830                incr update_index_cp
1831                switch -glob -- [lindex $file_states($path) 0] {
1832                U? {continue}
1833                ?M -
1834                ?D {
1835                        puts -nonewline $fd "[encoding convertto $path]\0"
1836                        display_file $path ?_
1837                }
1838                }
1839        }
1840
1841        set ui_status_value [format \
1842                "$msg... %i/%i files (%.2f%%)" \
1843                $update_index_cp \
1844                $totalCnt \
1845                [expr {100.0 * $update_index_cp / $totalCnt}]]
1846}
1847
1848######################################################################
1849##
1850## branch management
1851
1852proc is_tracking_branch {name} {
1853        global tracking_branches
1854
1855        if {![catch {set info $tracking_branches($name)}]} {
1856                return 1
1857        }
1858        foreach t [array names tracking_branches] {
1859                if {[string match {*/\*} $t] && [string match $t $name]} {
1860                        return 1
1861                }
1862        }
1863        return 0
1864}
1865
1866proc load_all_heads {} {
1867        global all_heads
1868
1869        set all_heads [list]
1870        set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1871        while {[gets $fd line] > 0} {
1872                if {[is_tracking_branch $line]} continue
1873                if {![regsub ^refs/heads/ $line {} name]} continue
1874                lappend all_heads $name
1875        }
1876        close $fd
1877
1878        set all_heads [lsort $all_heads]
1879}
1880
1881proc populate_branch_menu {} {
1882        global all_heads disable_on_lock
1883
1884        set m .mbar.branch
1885        set last [$m index last]
1886        for {set i 0} {$i <= $last} {incr i} {
1887                if {[$m type $i] eq {separator}} {
1888                        $m delete $i last
1889                        set new_dol [list]
1890                        foreach a $disable_on_lock {
1891                                if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1892                                        lappend new_dol $a
1893                                }
1894                        }
1895                        set disable_on_lock $new_dol
1896                        break
1897                }
1898        }
1899
1900        if {$all_heads ne {}} {
1901                $m add separator
1902        }
1903        foreach b $all_heads {
1904                $m add radiobutton \
1905                        -label $b \
1906                        -command [list switch_branch $b] \
1907                        -variable current_branch \
1908                        -value $b \
1909                        -font font_ui
1910                lappend disable_on_lock \
1911                        [list $m entryconf [$m index last] -state]
1912        }
1913}
1914
1915proc all_tracking_branches {} {
1916        global tracking_branches
1917
1918        set all_trackings {}
1919        set cmd {}
1920        foreach name [array names tracking_branches] {
1921                if {[regsub {/\*$} $name {} name]} {
1922                        lappend cmd $name
1923                } else {
1924                        regsub ^refs/(heads|remotes)/ $name {} name
1925                        lappend all_trackings $name
1926                }
1927        }
1928
1929        if {$cmd ne {}} {
1930                set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1931                while {[gets $fd name] > 0} {
1932                        regsub ^refs/(heads|remotes)/ $name {} name
1933                        lappend all_trackings $name
1934                }
1935                close $fd
1936        }
1937
1938        return [lsort -unique $all_trackings]
1939}
1940
1941proc load_all_tags {} {
1942        set all_tags [list]
1943        set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
1944        while {[gets $fd line] > 0} {
1945                if {![regsub ^refs/tags/ $line {} name]} continue
1946                lappend all_tags $name
1947        }
1948        close $fd
1949
1950        return [lsort $all_tags]
1951}
1952
1953proc do_create_branch_action {w} {
1954        global all_heads null_sha1 repo_config
1955        global create_branch_checkout create_branch_revtype
1956        global create_branch_head create_branch_trackinghead
1957        global create_branch_name create_branch_revexp
1958        global create_branch_tag
1959
1960        set newbranch $create_branch_name
1961        if {$newbranch eq {}
1962                || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1963                tk_messageBox \
1964                        -icon error \
1965                        -type ok \
1966                        -title [wm title $w] \
1967                        -parent $w \
1968                        -message "Please supply a branch name."
1969                focus $w.desc.name_t
1970                return
1971        }
1972        if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1973                tk_messageBox \
1974                        -icon error \
1975                        -type ok \
1976                        -title [wm title $w] \
1977                        -parent $w \
1978                        -message "Branch '$newbranch' already exists."
1979                focus $w.desc.name_t
1980                return
1981        }
1982        if {[catch {git check-ref-format "heads/$newbranch"}]} {
1983                tk_messageBox \
1984                        -icon error \
1985                        -type ok \
1986                        -title [wm title $w] \
1987                        -parent $w \
1988                        -message "We do not like '$newbranch' as a branch name."
1989                focus $w.desc.name_t
1990                return
1991        }
1992
1993        set rev {}
1994        switch -- $create_branch_revtype {
1995        head {set rev $create_branch_head}
1996        tracking {set rev $create_branch_trackinghead}
1997        tag {set rev $create_branch_tag}
1998        expression {set rev $create_branch_revexp}
1999        }
2000        if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
2001                tk_messageBox \
2002                        -icon error \
2003                        -type ok \
2004                        -title [wm title $w] \
2005                        -parent $w \
2006                        -message "Invalid starting revision: $rev"
2007                return
2008        }
2009        set cmd [list git update-ref]
2010        lappend cmd -m
2011        lappend cmd "branch: Created from $rev"
2012        lappend cmd "refs/heads/$newbranch"
2013        lappend cmd $cmt
2014        lappend cmd $null_sha1
2015        if {[catch {eval exec $cmd} err]} {
2016                tk_messageBox \
2017                        -icon error \
2018                        -type ok \
2019                        -title [wm title $w] \
2020                        -parent $w \
2021                        -message "Failed to create '$newbranch'.\n\n$err"
2022                return
2023        }
2024
2025        lappend all_heads $newbranch
2026        set all_heads [lsort $all_heads]
2027        populate_branch_menu
2028        destroy $w
2029        if {$create_branch_checkout} {
2030                switch_branch $newbranch
2031        }
2032}
2033
2034proc radio_selector {varname value args} {
2035        upvar #0 $varname var
2036        set var $value
2037}
2038
2039trace add variable create_branch_head write \
2040        [list radio_selector create_branch_revtype head]
2041trace add variable create_branch_trackinghead write \
2042        [list radio_selector create_branch_revtype tracking]
2043trace add variable create_branch_tag write \
2044        [list radio_selector create_branch_revtype tag]
2045
2046trace add variable delete_branch_head write \
2047        [list radio_selector delete_branch_checktype head]
2048trace add variable delete_branch_trackinghead write \
2049        [list radio_selector delete_branch_checktype tracking]
2050
2051proc do_create_branch {} {
2052        global all_heads current_branch repo_config
2053        global create_branch_checkout create_branch_revtype
2054        global create_branch_head create_branch_trackinghead
2055        global create_branch_name create_branch_revexp
2056        global create_branch_tag
2057
2058        set w .branch_editor
2059        toplevel $w
2060        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2061
2062        label $w.header -text {Create New Branch} \
2063                -font font_uibold
2064        pack $w.header -side top -fill x
2065
2066        frame $w.buttons
2067        button $w.buttons.create -text Create \
2068                -font font_ui \
2069                -default active \
2070                -command [list do_create_branch_action $w]
2071        pack $w.buttons.create -side right
2072        button $w.buttons.cancel -text {Cancel} \
2073                -font font_ui \
2074                -command [list destroy $w]
2075        pack $w.buttons.cancel -side right -padx 5
2076        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2077
2078        labelframe $w.desc \
2079                -text {Branch Description} \
2080                -font font_ui
2081        label $w.desc.name_l -text {Name:} -font font_ui
2082        entry $w.desc.name_t \
2083                -borderwidth 1 \
2084                -relief sunken \
2085                -width 40 \
2086                -textvariable create_branch_name \
2087                -font font_ui \
2088                -validate key \
2089                -validatecommand {
2090                        if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2091                        return 1
2092                }
2093        grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2094        grid columnconfigure $w.desc 1 -weight 1
2095        pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2096
2097        labelframe $w.from \
2098                -text {Starting Revision} \
2099                -font font_ui
2100        radiobutton $w.from.head_r \
2101                -text {Local Branch:} \
2102                -value head \
2103                -variable create_branch_revtype \
2104                -font font_ui
2105        eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2106        grid $w.from.head_r $w.from.head_m -sticky w
2107        set all_trackings [all_tracking_branches]
2108        if {$all_trackings ne {}} {
2109                set create_branch_trackinghead [lindex $all_trackings 0]
2110                radiobutton $w.from.tracking_r \
2111                        -text {Tracking Branch:} \
2112                        -value tracking \
2113                        -variable create_branch_revtype \
2114                        -font font_ui
2115                eval tk_optionMenu $w.from.tracking_m \
2116                        create_branch_trackinghead \
2117                        $all_trackings
2118                grid $w.from.tracking_r $w.from.tracking_m -sticky w
2119        }
2120        set all_tags [load_all_tags]
2121        if {$all_tags ne {}} {
2122                set create_branch_tag [lindex $all_tags 0]
2123                radiobutton $w.from.tag_r \
2124                        -text {Tag:} \
2125                        -value tag \
2126                        -variable create_branch_revtype \
2127                        -font font_ui
2128                eval tk_optionMenu $w.from.tag_m \
2129                        create_branch_tag \
2130                        $all_tags
2131                grid $w.from.tag_r $w.from.tag_m -sticky w
2132        }
2133        radiobutton $w.from.exp_r \
2134                -text {Revision Expression:} \
2135                -value expression \
2136                -variable create_branch_revtype \
2137                -font font_ui
2138        entry $w.from.exp_t \
2139                -borderwidth 1 \
2140                -relief sunken \
2141                -width 50 \
2142                -textvariable create_branch_revexp \
2143                -font font_ui \
2144                -validate key \
2145                -validatecommand {
2146                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2147                        if {%d == 1 && [string length %S] > 0} {
2148                                set create_branch_revtype expression
2149                        }
2150                        return 1
2151                }
2152        grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2153        grid columnconfigure $w.from 1 -weight 1
2154        pack $w.from -anchor nw -fill x -pady 5 -padx 5
2155
2156        labelframe $w.postActions \
2157                -text {Post Creation Actions} \
2158                -font font_ui
2159        checkbutton $w.postActions.checkout \
2160                -text {Checkout after creation} \
2161                -variable create_branch_checkout \
2162                -font font_ui
2163        pack $w.postActions.checkout -anchor nw
2164        pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2165
2166        set create_branch_checkout 1
2167        set create_branch_head $current_branch
2168        set create_branch_revtype head
2169        set create_branch_name $repo_config(gui.newbranchtemplate)
2170        set create_branch_revexp {}
2171
2172        bind $w <Visibility> "
2173                grab $w
2174                $w.desc.name_t icursor end
2175                focus $w.desc.name_t
2176        "
2177        bind $w <Key-Escape> "destroy $w"
2178        bind $w <Key-Return> "do_create_branch_action $w;break"
2179        wm title $w "[appname] ([reponame]): Create Branch"
2180        tkwait window $w
2181}
2182
2183proc do_delete_branch_action {w} {
2184        global all_heads
2185        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2186
2187        set check_rev {}
2188        switch -- $delete_branch_checktype {
2189        head {set check_rev $delete_branch_head}
2190        tracking {set check_rev $delete_branch_trackinghead}
2191        always {set check_rev {:none}}
2192        }
2193        if {$check_rev eq {:none}} {
2194                set check_cmt {}
2195        } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2196                tk_messageBox \
2197                        -icon error \
2198                        -type ok \
2199                        -title [wm title $w] \
2200                        -parent $w \
2201                        -message "Invalid check revision: $check_rev"
2202                return
2203        }
2204
2205        set to_delete [list]
2206        set not_merged [list]
2207        foreach i [$w.list.l curselection] {
2208                set b [$w.list.l get $i]
2209                if {[catch {set o [git rev-parse --verify $b]}]} continue
2210                if {$check_cmt ne {}} {
2211                        if {$b eq $check_rev} continue
2212                        if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2213                        if {$o ne $m} {
2214                                lappend not_merged $b
2215                                continue
2216                        }
2217                }
2218                lappend to_delete [list $b $o]
2219        }
2220        if {$not_merged ne {}} {
2221                set msg "The following branches are not completely merged into $check_rev:
2222
2223 - [join $not_merged "\n - "]"
2224                tk_messageBox \
2225                        -icon info \
2226                        -type ok \
2227                        -title [wm title $w] \
2228                        -parent $w \
2229                        -message $msg
2230        }
2231        if {$to_delete eq {}} return
2232        if {$delete_branch_checktype eq {always}} {
2233                set msg {Recovering deleted branches is difficult.
2234
2235Delete the selected branches?}
2236                if {[tk_messageBox \
2237                        -icon warning \
2238                        -type yesno \
2239                        -title [wm title $w] \
2240                        -parent $w \
2241                        -message $msg] ne yes} {
2242                        return
2243                }
2244        }
2245
2246        set failed {}
2247        foreach i $to_delete {
2248                set b [lindex $i 0]
2249                set o [lindex $i 1]
2250                if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2251                        append failed " - $b: $err\n"
2252                } else {
2253                        set x [lsearch -sorted -exact $all_heads $b]
2254                        if {$x >= 0} {
2255                                set all_heads [lreplace $all_heads $x $x]
2256                        }
2257                }
2258        }
2259
2260        if {$failed ne {}} {
2261                tk_messageBox \
2262                        -icon error \
2263                        -type ok \
2264                        -title [wm title $w] \
2265                        -parent $w \
2266                        -message "Failed to delete branches:\n$failed"
2267        }
2268
2269        set all_heads [lsort $all_heads]
2270        populate_branch_menu
2271        destroy $w
2272}
2273
2274proc do_delete_branch {} {
2275        global all_heads tracking_branches current_branch
2276        global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2277
2278        set w .branch_editor
2279        toplevel $w
2280        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2281
2282        label $w.header -text {Delete Local Branch} \
2283                -font font_uibold
2284        pack $w.header -side top -fill x
2285
2286        frame $w.buttons
2287        button $w.buttons.create -text Delete \
2288                -font font_ui \
2289                -command [list do_delete_branch_action $w]
2290        pack $w.buttons.create -side right
2291        button $w.buttons.cancel -text {Cancel} \
2292                -font font_ui \
2293                -command [list destroy $w]
2294        pack $w.buttons.cancel -side right -padx 5
2295        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2296
2297        labelframe $w.list \
2298                -text {Local Branches} \
2299                -font font_ui
2300        listbox $w.list.l \
2301                -height 10 \
2302                -width 70 \
2303                -selectmode extended \
2304                -yscrollcommand [list $w.list.sby set] \
2305                -font font_ui
2306        foreach h $all_heads {
2307                if {$h ne $current_branch} {
2308                        $w.list.l insert end $h
2309                }
2310        }
2311        scrollbar $w.list.sby -command [list $w.list.l yview]
2312        pack $w.list.sby -side right -fill y
2313        pack $w.list.l -side left -fill both -expand 1
2314        pack $w.list -fill both -expand 1 -pady 5 -padx 5
2315
2316        labelframe $w.validate \
2317                -text {Delete Only If} \
2318                -font font_ui
2319        radiobutton $w.validate.head_r \
2320                -text {Merged Into Local Branch:} \
2321                -value head \
2322                -variable delete_branch_checktype \
2323                -font font_ui
2324        eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2325        grid $w.validate.head_r $w.validate.head_m -sticky w
2326        set all_trackings [all_tracking_branches]
2327        if {$all_trackings ne {}} {
2328                set delete_branch_trackinghead [lindex $all_trackings 0]
2329                radiobutton $w.validate.tracking_r \
2330                        -text {Merged Into Tracking Branch:} \
2331                        -value tracking \
2332                        -variable delete_branch_checktype \
2333                        -font font_ui
2334                eval tk_optionMenu $w.validate.tracking_m \
2335                        delete_branch_trackinghead \
2336                        $all_trackings
2337                grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2338        }
2339        radiobutton $w.validate.always_r \
2340                -text {Always (Do not perform merge checks)} \
2341                -value always \
2342                -variable delete_branch_checktype \
2343                -font font_ui
2344        grid $w.validate.always_r -columnspan 2 -sticky w
2345        grid columnconfigure $w.validate 1 -weight 1
2346        pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2347
2348        set delete_branch_head $current_branch
2349        set delete_branch_checktype head
2350
2351        bind $w <Visibility> "grab $w; focus $w"
2352        bind $w <Key-Escape> "destroy $w"
2353        wm title $w "[appname] ([reponame]): Delete Branch"
2354        tkwait window $w
2355}
2356
2357proc switch_branch {new_branch} {
2358        global HEAD commit_type current_branch repo_config
2359
2360        if {![lock_index switch]} return
2361
2362        # -- Our in memory state should match the repository.
2363        #
2364        repository_state curType curHEAD curMERGE_HEAD
2365        if {[string match amend* $commit_type]
2366                && $curType eq {normal}
2367                && $curHEAD eq $HEAD} {
2368        } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2369                info_popup {Last scanned state does not match repository state.
2370
2371Another Git program has modified this repository
2372since the last scan.  A rescan must be performed
2373before the current branch can be changed.
2374
2375The rescan will be automatically started now.
2376}
2377                unlock_index
2378                rescan {set ui_status_value {Ready.}}
2379                return
2380        }
2381
2382        # -- Don't do a pointless switch.
2383        #
2384        if {$current_branch eq $new_branch} {
2385                unlock_index
2386                return
2387        }
2388
2389        if {$repo_config(gui.trustmtime) eq {true}} {
2390                switch_branch_stage2 {} $new_branch
2391        } else {
2392                set ui_status_value {Refreshing file status...}
2393                set cmd [list git update-index]
2394                lappend cmd -q
2395                lappend cmd --unmerged
2396                lappend cmd --ignore-missing
2397                lappend cmd --refresh
2398                set fd_rf [open "| $cmd" r]
2399                fconfigure $fd_rf -blocking 0 -translation binary
2400                fileevent $fd_rf readable \
2401                        [list switch_branch_stage2 $fd_rf $new_branch]
2402        }
2403}
2404
2405proc switch_branch_stage2 {fd_rf new_branch} {
2406        global ui_status_value HEAD
2407
2408        if {$fd_rf ne {}} {
2409                read $fd_rf
2410                if {![eof $fd_rf]} return
2411                close $fd_rf
2412        }
2413
2414        set ui_status_value "Updating working directory to '$new_branch'..."
2415        set cmd [list git read-tree]
2416        lappend cmd -m
2417        lappend cmd -u
2418        lappend cmd --exclude-per-directory=.gitignore
2419        lappend cmd $HEAD
2420        lappend cmd $new_branch
2421        set fd_rt [open "| $cmd" r]
2422        fconfigure $fd_rt -blocking 0 -translation binary
2423        fileevent $fd_rt readable \
2424                [list switch_branch_readtree_wait $fd_rt $new_branch]
2425}
2426
2427proc switch_branch_readtree_wait {fd_rt new_branch} {
2428        global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2429        global current_branch
2430        global ui_comm ui_status_value
2431
2432        # -- We never get interesting output on stdout; only stderr.
2433        #
2434        read $fd_rt
2435        fconfigure $fd_rt -blocking 1
2436        if {![eof $fd_rt]} {
2437                fconfigure $fd_rt -blocking 0
2438                return
2439        }
2440
2441        # -- The working directory wasn't in sync with the index and
2442        #    we'd have to overwrite something to make the switch. A
2443        #    merge is required.
2444        #
2445        if {[catch {close $fd_rt} err]} {
2446                regsub {^fatal: } $err {} err
2447                warn_popup "File level merge required.
2448
2449$err
2450
2451Staying on branch '$current_branch'."
2452                set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2453                unlock_index
2454                return
2455        }
2456
2457        # -- Update the symbolic ref.  Core git doesn't even check for failure
2458        #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2459        #    state that is difficult to recover from within git-gui.
2460        #
2461        if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2462                error_popup "Failed to set current branch.
2463
2464This working directory is only partially switched.
2465We successfully updated your files, but failed to
2466update an internal Git file.
2467
2468This should not have occurred.  [appname] will now
2469close and give up.
2470
2471$err"
2472                do_quit
2473                return
2474        }
2475
2476        # -- Update our repository state.  If we were previously in amend mode
2477        #    we need to toss the current buffer and do a full rescan to update
2478        #    our file lists.  If we weren't in amend mode our file lists are
2479        #    accurate and we can avoid the rescan.
2480        #
2481        unlock_index
2482        set selected_commit_type new
2483        if {[string match amend* $commit_type]} {
2484                $ui_comm delete 0.0 end
2485                $ui_comm edit reset
2486                $ui_comm edit modified false
2487                rescan {set ui_status_value "Checked out branch '$current_branch'."}
2488        } else {
2489                repository_state commit_type HEAD MERGE_HEAD
2490                set PARENT $HEAD
2491                set ui_status_value "Checked out branch '$current_branch'."
2492        }
2493}
2494
2495######################################################################
2496##
2497## remote management
2498
2499proc load_all_remotes {} {
2500        global repo_config
2501        global all_remotes tracking_branches
2502
2503        set all_remotes [list]
2504        array unset tracking_branches
2505
2506        set rm_dir [gitdir remotes]
2507        if {[file isdirectory $rm_dir]} {
2508                set all_remotes [glob \
2509                        -types f \
2510                        -tails \
2511                        -nocomplain \
2512                        -directory $rm_dir *]
2513
2514                foreach name $all_remotes {
2515                        catch {
2516                                set fd [open [file join $rm_dir $name] r]
2517                                while {[gets $fd line] >= 0} {
2518                                        if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2519                                                $line line src dst]} continue
2520                                        if {![regexp ^refs/ $dst]} {
2521                                                set dst "refs/heads/$dst"
2522                                        }
2523                                        set tracking_branches($dst) [list $name $src]
2524                                }
2525                                close $fd
2526                        }
2527                }
2528        }
2529
2530        foreach line [array names repo_config remote.*.url] {
2531                if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2532                lappend all_remotes $name
2533
2534                if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2535                        set fl {}
2536                }
2537                foreach line $fl {
2538                        if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2539                        if {![regexp ^refs/ $dst]} {
2540                                set dst "refs/heads/$dst"
2541                        }
2542                        set tracking_branches($dst) [list $name $src]
2543                }
2544        }
2545
2546        set all_remotes [lsort -unique $all_remotes]
2547}
2548
2549proc populate_fetch_menu {} {
2550        global all_remotes repo_config
2551
2552        set m .mbar.fetch
2553        foreach r $all_remotes {
2554                set enable 0
2555                if {![catch {set a $repo_config(remote.$r.url)}]} {
2556                        if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2557                                set enable 1
2558                        }
2559                } else {
2560                        catch {
2561                                set fd [open [gitdir remotes $r] r]
2562                                while {[gets $fd n] >= 0} {
2563                                        if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2564                                                set enable 1
2565                                                break
2566                                        }
2567                                }
2568                                close $fd
2569                        }
2570                }
2571
2572                if {$enable} {
2573                        $m add command \
2574                                -label "Fetch from $r..." \
2575                                -command [list fetch_from $r] \
2576                                -font font_ui
2577                }
2578        }
2579}
2580
2581proc populate_push_menu {} {
2582        global all_remotes repo_config
2583
2584        set m .mbar.push
2585        set fast_count 0
2586        foreach r $all_remotes {
2587                set enable 0
2588                if {![catch {set a $repo_config(remote.$r.url)}]} {
2589                        if {![catch {set a $repo_config(remote.$r.push)}]} {
2590                                set enable 1
2591                        }
2592                } else {
2593                        catch {
2594                                set fd [open [gitdir remotes $r] r]
2595                                while {[gets $fd n] >= 0} {
2596                                        if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2597                                                set enable 1
2598                                                break
2599                                        }
2600                                }
2601                                close $fd
2602                        }
2603                }
2604
2605                if {$enable} {
2606                        if {!$fast_count} {
2607                                $m add separator
2608                        }
2609                        $m add command \
2610                                -label "Push to $r..." \
2611                                -command [list push_to $r] \
2612                                -font font_ui
2613                        incr fast_count
2614                }
2615        }
2616}
2617
2618proc start_push_anywhere_action {w} {
2619        global push_urltype push_remote push_url push_thin push_tags
2620
2621        set r_url {}
2622        switch -- $push_urltype {
2623        remote {set r_url $push_remote}
2624        url {set r_url $push_url}
2625        }
2626        if {$r_url eq {}} return
2627
2628        set cmd [list git push]
2629        lappend cmd -v
2630        if {$push_thin} {
2631                lappend cmd --thin
2632        }
2633        if {$push_tags} {
2634                lappend cmd --tags
2635        }
2636        lappend cmd $r_url
2637        set cnt 0
2638        foreach i [$w.source.l curselection] {
2639                set b [$w.source.l get $i]
2640                lappend cmd "refs/heads/$b:refs/heads/$b"
2641                incr cnt
2642        }
2643        if {$cnt == 0} {
2644                return
2645        } elseif {$cnt == 1} {
2646                set unit branch
2647        } else {
2648                set unit branches
2649        }
2650
2651        set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2652        console_exec $cons $cmd console_done
2653        destroy $w
2654}
2655
2656trace add variable push_remote write \
2657        [list radio_selector push_urltype remote]
2658
2659proc do_push_anywhere {} {
2660        global all_heads all_remotes current_branch
2661        global push_urltype push_remote push_url push_thin push_tags
2662
2663        set w .push_setup
2664        toplevel $w
2665        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2666
2667        label $w.header -text {Push Branches} -font font_uibold
2668        pack $w.header -side top -fill x
2669
2670        frame $w.buttons
2671        button $w.buttons.create -text Push \
2672                -font font_ui \
2673                -command [list start_push_anywhere_action $w]
2674        pack $w.buttons.create -side right
2675        button $w.buttons.cancel -text {Cancel} \
2676                -font font_ui \
2677                -command [list destroy $w]
2678        pack $w.buttons.cancel -side right -padx 5
2679        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2680
2681        labelframe $w.source \
2682                -text {Source Branches} \
2683                -font font_ui
2684        listbox $w.source.l \
2685                -height 10 \
2686                -width 70 \
2687                -selectmode extended \
2688                -yscrollcommand [list $w.source.sby set] \
2689                -font font_ui
2690        foreach h $all_heads {
2691                $w.source.l insert end $h
2692                if {$h eq $current_branch} {
2693                        $w.source.l select set end
2694                }
2695        }
2696        scrollbar $w.source.sby -command [list $w.source.l yview]
2697        pack $w.source.sby -side right -fill y
2698        pack $w.source.l -side left -fill both -expand 1
2699        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2700
2701        labelframe $w.dest \
2702                -text {Destination Repository} \
2703                -font font_ui
2704        if {$all_remotes ne {}} {
2705                radiobutton $w.dest.remote_r \
2706                        -text {Remote:} \
2707                        -value remote \
2708                        -variable push_urltype \
2709                        -font font_ui
2710                eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2711                grid $w.dest.remote_r $w.dest.remote_m -sticky w
2712                if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2713                        set push_remote origin
2714                } else {
2715                        set push_remote [lindex $all_remotes 0]
2716                }
2717                set push_urltype remote
2718        } else {
2719                set push_urltype url
2720        }
2721        radiobutton $w.dest.url_r \
2722                -text {Arbitrary URL:} \
2723                -value url \
2724                -variable push_urltype \
2725                -font font_ui
2726        entry $w.dest.url_t \
2727                -borderwidth 1 \
2728                -relief sunken \
2729                -width 50 \
2730                -textvariable push_url \
2731                -font font_ui \
2732                -validate key \
2733                -validatecommand {
2734                        if {%d == 1 && [regexp {\s} %S]} {return 0}
2735                        if {%d == 1 && [string length %S] > 0} {
2736                                set push_urltype url
2737                        }
2738                        return 1
2739                }
2740        grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2741        grid columnconfigure $w.dest 1 -weight 1
2742        pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2743
2744        labelframe $w.options \
2745                -text {Transfer Options} \
2746                -font font_ui
2747        checkbutton $w.options.thin \
2748                -text {Use thin pack (for slow network connections)} \
2749                -variable push_thin \
2750                -font font_ui
2751        grid $w.options.thin -columnspan 2 -sticky w
2752        checkbutton $w.options.tags \
2753                -text {Include tags} \
2754                -variable push_tags \
2755                -font font_ui
2756        grid $w.options.tags -columnspan 2 -sticky w
2757        grid columnconfigure $w.options 1 -weight 1
2758        pack $w.options -anchor nw -fill x -pady 5 -padx 5
2759
2760        set push_url {}
2761        set push_thin 0
2762        set push_tags 0
2763
2764        bind $w <Visibility> "grab $w"
2765        bind $w <Key-Escape> "destroy $w"
2766        wm title $w "[appname] ([reponame]): Push"
2767        tkwait window $w
2768}
2769
2770######################################################################
2771##
2772## merge
2773
2774proc can_merge {} {
2775        global HEAD commit_type file_states
2776
2777        if {[string match amend* $commit_type]} {
2778                info_popup {Cannot merge while amending.
2779
2780You must finish amending this commit before
2781starting any type of merge.
2782}
2783                return 0
2784        }
2785
2786        if {[committer_ident] eq {}} {return 0}
2787        if {![lock_index merge]} {return 0}
2788
2789        # -- Our in memory state should match the repository.
2790        #
2791        repository_state curType curHEAD curMERGE_HEAD
2792        if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2793                info_popup {Last scanned state does not match repository state.
2794
2795Another Git program has modified this repository
2796since the last scan.  A rescan must be performed
2797before a merge can be performed.
2798
2799The rescan will be automatically started now.
2800}
2801                unlock_index
2802                rescan {set ui_status_value {Ready.}}
2803                return 0
2804        }
2805
2806        foreach path [array names file_states] {
2807                switch -glob -- [lindex $file_states($path) 0] {
2808                _O {
2809                        continue; # and pray it works!
2810                }
2811                U? {
2812                        error_popup "You are in the middle of a conflicted merge.
2813
2814File [short_path $path] has merge conflicts.
2815
2816You must resolve them, add the file, and commit to
2817complete the current merge.  Only then can you
2818begin another merge.
2819"
2820                        unlock_index
2821                        return 0
2822                }
2823                ?? {
2824                        error_popup "You are in the middle of a change.
2825
2826File [short_path $path] is modified.
2827
2828You should complete the current commit before
2829starting a merge.  Doing so will help you abort
2830a failed merge, should the need arise.
2831"
2832                        unlock_index
2833                        return 0
2834                }
2835                }
2836        }
2837
2838        return 1
2839}
2840
2841proc visualize_local_merge {w} {
2842        set revs {}
2843        foreach i [$w.source.l curselection] {
2844                lappend revs [$w.source.l get $i]
2845        }
2846        if {$revs eq {}} return
2847        lappend revs --not HEAD
2848        do_gitk $revs
2849}
2850
2851proc start_local_merge_action {w} {
2852        global HEAD ui_status_value current_branch
2853
2854        set cmd [list git merge]
2855        set names {}
2856        set revcnt 0
2857        foreach i [$w.source.l curselection] {
2858                set b [$w.source.l get $i]
2859                lappend cmd $b
2860                lappend names $b
2861                incr revcnt
2862        }
2863
2864        if {$revcnt == 0} {
2865                return
2866        } elseif {$revcnt == 1} {
2867                set unit branch
2868        } elseif {$revcnt <= 15} {
2869                set unit branches
2870        } else {
2871                tk_messageBox \
2872                        -icon error \
2873                        -type ok \
2874                        -title [wm title $w] \
2875                        -parent $w \
2876                        -message "Too many branches selected.
2877
2878You have requested to merge $revcnt branches
2879in an octopus merge.  This exceeds Git's
2880internal limit of 15 branches per merge.
2881
2882Please select fewer branches.  To merge more
2883than 15 branches, merge the branches in batches.
2884"
2885                return
2886        }
2887
2888        set msg "Merging $current_branch, [join $names {, }]"
2889        set ui_status_value "$msg..."
2890        set cons [new_console "Merge" $msg]
2891        console_exec $cons $cmd [list finish_merge $revcnt]
2892        bind $w <Destroy> {}
2893        destroy $w
2894}
2895
2896proc finish_merge {revcnt w ok} {
2897        console_done $w $ok
2898        if {$ok} {
2899                set msg {Merge completed successfully.}
2900        } else {
2901                if {$revcnt != 1} {
2902                        info_popup "Octopus merge failed.
2903
2904Your merge of $revcnt branches has failed.
2905
2906There are file-level conflicts between the
2907branches which must be resolved manually.
2908
2909The working directory will now be reset.
2910
2911You can attempt this merge again
2912by merging only one branch at a time." $w
2913
2914                        set fd [open "| git read-tree --reset -u HEAD" r]
2915                        fconfigure $fd -blocking 0 -translation binary
2916                        fileevent $fd readable [list reset_hard_wait $fd]
2917                        set ui_status_value {Aborting... please wait...}
2918                        return
2919                }
2920
2921                set msg {Merge failed.  Conflict resolution is required.}
2922        }
2923        unlock_index
2924        rescan [list set ui_status_value $msg]
2925}
2926
2927proc do_local_merge {} {
2928        global current_branch
2929
2930        if {![can_merge]} return
2931
2932        set w .merge_setup
2933        toplevel $w
2934        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2935
2936        label $w.header \
2937                -text "Merge Into $current_branch" \
2938                -font font_uibold
2939        pack $w.header -side top -fill x
2940
2941        frame $w.buttons
2942        button $w.buttons.visualize -text Visualize \
2943                -font font_ui \
2944                -command [list visualize_local_merge $w]
2945        pack $w.buttons.visualize -side left
2946        button $w.buttons.create -text Merge \
2947                -font font_ui \
2948                -command [list start_local_merge_action $w]
2949        pack $w.buttons.create -side right
2950        button $w.buttons.cancel -text {Cancel} \
2951                -font font_ui \
2952                -command [list destroy $w]
2953        pack $w.buttons.cancel -side right -padx 5
2954        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2955
2956        labelframe $w.source \
2957                -text {Source Branches} \
2958                -font font_ui
2959        listbox $w.source.l \
2960                -height 10 \
2961                -width 70 \
2962                -selectmode extended \
2963                -yscrollcommand [list $w.source.sby set] \
2964                -font font_ui
2965        scrollbar $w.source.sby -command [list $w.source.l yview]
2966        pack $w.source.sby -side right -fill y
2967        pack $w.source.l -side left -fill both -expand 1
2968        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2969
2970        set cmd [list git for-each-ref]
2971        lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2972        lappend cmd refs/heads
2973        lappend cmd refs/remotes
2974        lappend cmd refs/tags
2975        set fr_fd [open "| $cmd" r]
2976        fconfigure $fr_fd -translation binary
2977        while {[gets $fr_fd line] > 0} {
2978                set line [split $line { }]
2979                set sha1([lindex $line 0]) [lindex $line 2]
2980                set sha1([lindex $line 1]) [lindex $line 2]
2981        }
2982        close $fr_fd
2983
2984        set to_show {}
2985        set fr_fd [open "| git rev-list --all --not HEAD"]
2986        while {[gets $fr_fd line] > 0} {
2987                if {[catch {set ref $sha1($line)}]} continue
2988                regsub ^refs/(heads|remotes|tags)/ $ref {} ref
2989                lappend to_show $ref
2990        }
2991        close $fr_fd
2992
2993        foreach ref [lsort -unique $to_show] {
2994                $w.source.l insert end $ref
2995        }
2996
2997        bind $w <Visibility> "grab $w"
2998        bind $w <Key-Escape> "unlock_index;destroy $w"
2999        bind $w <Destroy> unlock_index
3000        wm title $w "[appname] ([reponame]): Merge"
3001        tkwait window $w
3002}
3003
3004proc do_reset_hard {} {
3005        global HEAD commit_type file_states
3006
3007        if {[string match amend* $commit_type]} {
3008                info_popup {Cannot abort while amending.
3009
3010You must finish amending this commit.
3011}
3012                return
3013        }
3014
3015        if {![lock_index abort]} return
3016
3017        if {[string match *merge* $commit_type]} {
3018                set op merge
3019        } else {
3020                set op commit
3021        }
3022
3023        if {[ask_popup "Abort $op?
3024
3025Aborting the current $op will cause
3026*ALL* uncommitted changes to be lost.
3027
3028Continue with aborting the current $op?"] eq {yes}} {
3029                set fd [open "| git read-tree --reset -u HEAD" r]
3030                fconfigure $fd -blocking 0 -translation binary
3031                fileevent $fd readable [list reset_hard_wait $fd]
3032                set ui_status_value {Aborting... please wait...}
3033        } else {
3034                unlock_index
3035        }
3036}
3037
3038proc reset_hard_wait {fd} {
3039        global ui_comm
3040
3041        read $fd
3042        if {[eof $fd]} {
3043                close $fd
3044                unlock_index
3045
3046                $ui_comm delete 0.0 end
3047                $ui_comm edit modified false
3048
3049                catch {file delete [gitdir MERGE_HEAD]}
3050                catch {file delete [gitdir rr-cache MERGE_RR]}
3051                catch {file delete [gitdir SQUASH_MSG]}
3052                catch {file delete [gitdir MERGE_MSG]}
3053                catch {file delete [gitdir GITGUI_MSG]}
3054
3055                rescan {set ui_status_value {Abort completed.  Ready.}}
3056        }
3057}
3058
3059######################################################################
3060##
3061## browser
3062
3063set next_browser_id 0
3064
3065proc new_browser {commit} {
3066        global next_browser_id cursor_ptr M1B
3067        global browser_commit browser_status browser_stack browser_path browser_busy
3068
3069        if {[winfo ismapped .]} {
3070                set w .browser[incr next_browser_id]
3071                set tl $w
3072                toplevel $w
3073        } else {
3074                set w {}
3075                set tl .
3076        }
3077        set w_list $w.list.l
3078        set browser_commit($w_list) $commit
3079        set browser_status($w_list) {Starting...}
3080        set browser_stack($w_list) {}
3081        set browser_path($w_list) $browser_commit($w_list):
3082        set browser_busy($w_list) 1
3083
3084        label $w.path -textvariable browser_path($w_list) \
3085                -anchor w \
3086                -justify left \
3087                -borderwidth 1 \
3088                -relief sunken \
3089                -font font_uibold
3090        pack $w.path -anchor w -side top -fill x
3091
3092        frame $w.list
3093        text $w_list -background white -borderwidth 0 \
3094                -cursor $cursor_ptr \
3095                -state disabled \
3096                -wrap none \
3097                -height 20 \
3098                -width 70 \
3099                -xscrollcommand [list $w.list.sbx set] \
3100                -yscrollcommand [list $w.list.sby set] \
3101                -font font_ui
3102        $w_list tag conf in_sel \
3103                -background [$w_list cget -foreground] \
3104                -foreground [$w_list cget -background]
3105        scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3106        scrollbar $w.list.sby -orient v -command [list $w_list yview]
3107        pack $w.list.sbx -side bottom -fill x
3108        pack $w.list.sby -side right -fill y
3109        pack $w_list -side left -fill both -expand 1
3110        pack $w.list -side top -fill both -expand 1
3111
3112        label $w.status -textvariable browser_status($w_list) \
3113                -anchor w \
3114                -justify left \
3115                -borderwidth 1 \
3116                -relief sunken \
3117                -font font_ui
3118        pack $w.status -anchor w -side bottom -fill x
3119
3120        bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3121        bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3122        bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3123        bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3124        bind $w_list <Up>              "browser_move -1 $w_list;break"
3125        bind $w_list <Down>            "browser_move 1 $w_list;break"
3126        bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3127        bind $w_list <Return>          "browser_enter $w_list;break"
3128        bind $w_list <Prior>           "browser_page -1 $w_list;break"
3129        bind $w_list <Next>            "browser_page 1 $w_list;break"
3130        bind $w_list <Left>            break
3131        bind $w_list <Right>           break
3132
3133        bind $tl <Visibility> "focus $w"
3134        bind $tl <Destroy> "
3135                array unset browser_buffer $w_list
3136                array unset browser_files $w_list
3137                array unset browser_status $w_list
3138                array unset browser_stack $w_list
3139                array unset browser_path $w_list
3140                array unset browser_commit $w_list
3141                array unset browser_busy $w_list
3142        "
3143        wm title $tl "[appname] ([reponame]): File Browser"
3144        ls_tree $w_list $browser_commit($w_list) {}
3145}
3146
3147proc browser_move {dir w} {
3148        global browser_files browser_busy
3149
3150        if {$browser_busy($w)} return
3151        set lno [lindex [split [$w index in_sel.first] .] 0]
3152        incr lno $dir
3153        if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3154                $w tag remove in_sel 0.0 end
3155                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3156                $w see $lno.0
3157        }
3158}
3159
3160proc browser_page {dir w} {
3161        global browser_files browser_busy
3162
3163        if {$browser_busy($w)} return
3164        $w yview scroll $dir pages
3165        set lno [expr {int(
3166                  [lindex [$w yview] 0]
3167                * [llength $browser_files($w)]
3168                + 1)}]
3169        if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3170                $w tag remove in_sel 0.0 end
3171                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3172                $w see $lno.0
3173        }
3174}
3175
3176proc browser_parent {w} {
3177        global browser_files browser_status browser_path
3178        global browser_stack browser_busy
3179
3180        if {$browser_busy($w)} return
3181        set info [lindex $browser_files($w) 0]
3182        if {[lindex $info 0] eq {parent}} {
3183                set parent [lindex $browser_stack($w) end-1]
3184                set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3185                if {$browser_stack($w) eq {}} {
3186                        regsub {:.*$} $browser_path($w) {:} browser_path($w)
3187                } else {
3188                        regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3189                }
3190                set browser_status($w) "Loading $browser_path($w)..."
3191                ls_tree $w [lindex $parent 0] [lindex $parent 1]
3192        }
3193}
3194
3195proc browser_enter {w} {
3196        global browser_files browser_status browser_path
3197        global browser_commit browser_stack browser_busy
3198
3199        if {$browser_busy($w)} return
3200        set lno [lindex [split [$w index in_sel.first] .] 0]
3201        set info [lindex $browser_files($w) [expr {$lno - 1}]]
3202        if {$info ne {}} {
3203                switch -- [lindex $info 0] {
3204                parent {
3205                        browser_parent $w
3206                }
3207                tree {
3208                        set name [lindex $info 2]
3209                        set escn [escape_path $name]
3210                        set browser_status($w) "Loading $escn..."
3211                        append browser_path($w) $escn
3212                        ls_tree $w [lindex $info 1] $name
3213                }
3214                blob {
3215                        set name [lindex $info 2]
3216                        set p {}
3217                        foreach n $browser_stack($w) {
3218                                append p [lindex $n 1]
3219                        }
3220                        append p $name
3221                        show_blame $browser_commit($w) $p
3222                }
3223                }
3224        }
3225}
3226
3227proc browser_click {was_double_click w pos} {
3228        global browser_files browser_busy
3229
3230        if {$browser_busy($w)} return
3231        set lno [lindex [split [$w index $pos] .] 0]
3232        focus $w
3233
3234        if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3235                $w tag remove in_sel 0.0 end
3236                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3237                if {$was_double_click} {
3238                        browser_enter $w
3239                }
3240        }
3241}
3242
3243proc ls_tree {w tree_id name} {
3244        global browser_buffer browser_files browser_stack browser_busy
3245
3246        set browser_buffer($w) {}
3247        set browser_files($w) {}
3248        set browser_busy($w) 1
3249
3250        $w conf -state normal
3251        $w tag remove in_sel 0.0 end
3252        $w delete 0.0 end
3253        if {$browser_stack($w) ne {}} {
3254                $w image create end \
3255                        -align center -padx 5 -pady 1 \
3256                        -name icon0 \
3257                        -image file_uplevel
3258                $w insert end {[Up To Parent]}
3259                lappend browser_files($w) parent
3260        }
3261        lappend browser_stack($w) [list $tree_id $name]
3262        $w conf -state disabled
3263
3264        set cmd [list git ls-tree -z $tree_id]
3265        set fd [open "| $cmd" r]
3266        fconfigure $fd -blocking 0 -translation binary -encoding binary
3267        fileevent $fd readable [list read_ls_tree $fd $w]
3268}
3269
3270proc read_ls_tree {fd w} {
3271        global browser_buffer browser_files browser_status browser_busy
3272
3273        if {![winfo exists $w]} {
3274                catch {close $fd}
3275                return
3276        }
3277
3278        append browser_buffer($w) [read $fd]
3279        set pck [split $browser_buffer($w) "\0"]
3280        set browser_buffer($w) [lindex $pck end]
3281
3282        set n [llength $browser_files($w)]
3283        $w conf -state normal
3284        foreach p [lrange $pck 0 end-1] {
3285                set info [split $p "\t"]
3286                set path [lindex $info 1]
3287                set info [split [lindex $info 0] { }]
3288                set type [lindex $info 1]
3289                set object [lindex $info 2]
3290
3291                switch -- $type {
3292                blob {
3293                        set image file_mod
3294                }
3295                tree {
3296                        set image file_dir
3297                        append path /
3298                }
3299                default {
3300                        set image file_question
3301                }
3302                }
3303
3304                if {$n > 0} {$w insert end "\n"}
3305                $w image create end \
3306                        -align center -padx 5 -pady 1 \
3307                        -name icon[incr n] \
3308                        -image $image
3309                $w insert end [escape_path $path]
3310                lappend browser_files($w) [list $type $object $path]
3311        }
3312        $w conf -state disabled
3313
3314        if {[eof $fd]} {
3315                close $fd
3316                set browser_status($w) Ready.
3317                set browser_busy($w) 0
3318                array unset browser_buffer $w
3319                if {$n > 0} {
3320                        $w tag add in_sel 1.0 2.0
3321                        focus -force $w
3322                }
3323        }
3324}
3325
3326proc show_blame {commit path} {
3327        global next_browser_id blame_status blame_data
3328
3329        if {[winfo ismapped .]} {
3330                set w .browser[incr next_browser_id]
3331                set tl $w
3332                toplevel $w
3333        } else {
3334                set w {}
3335                set tl .
3336        }
3337        set blame_status($w) {Loading current file content...}
3338
3339        label $w.path -text "$commit:$path" \
3340                -anchor w \
3341                -justify left \
3342                -borderwidth 1 \
3343                -relief sunken \
3344                -font font_uibold
3345        pack $w.path -side top -fill x
3346
3347        frame $w.out
3348        text $w.out.loaded_t \
3349                -background white -borderwidth 0 \
3350                -state disabled \
3351                -wrap none \
3352                -height 40 \
3353                -width 1 \
3354                -font font_diff
3355        $w.out.loaded_t tag conf annotated -background grey
3356
3357        text $w.out.linenumber_t \
3358                -background white -borderwidth 0 \
3359                -state disabled \
3360                -wrap none \
3361                -height 40 \
3362                -width 5 \
3363                -font font_diff
3364        $w.out.linenumber_t tag conf linenumber -justify right
3365
3366        text $w.out.file_t \
3367                -background white -borderwidth 0 \
3368                -state disabled \
3369                -wrap none \
3370                -height 40 \
3371                -width 80 \
3372                -xscrollcommand [list $w.out.sbx set] \
3373                -font font_diff
3374
3375        scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3376        scrollbar $w.out.sby -orient v \
3377                -command [list scrollbar2many [list \
3378                $w.out.loaded_t \
3379                $w.out.linenumber_t \
3380                $w.out.file_t \
3381                ] yview]
3382        grid \
3383                $w.out.linenumber_t \
3384                $w.out.loaded_t \
3385                $w.out.file_t \
3386                $w.out.sby \
3387                -sticky nsew
3388        grid conf $w.out.sbx -column 2 -sticky we
3389        grid columnconfigure $w.out 2 -weight 1
3390        grid rowconfigure $w.out 0 -weight 1
3391        pack $w.out -fill both -expand 1
3392
3393        label $w.status -textvariable blame_status($w) \
3394                -anchor w \
3395                -justify left \
3396                -borderwidth 1 \
3397                -relief sunken \
3398                -font font_ui
3399        pack $w.status -side bottom -fill x
3400
3401        frame $w.cm
3402        text $w.cm.t \
3403                -background white -borderwidth 0 \
3404                -state disabled \
3405                -wrap none \
3406                -height 10 \
3407                -width 80 \
3408                -xscrollcommand [list $w.cm.sbx set] \
3409                -yscrollcommand [list $w.cm.sby set] \
3410                -font font_diff
3411        scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3412        scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3413        pack $w.cm.sby -side right -fill y
3414        pack $w.cm.sbx -side bottom -fill x
3415        pack $w.cm.t -expand 1 -fill both
3416        pack $w.cm -side bottom -fill x
3417
3418        menu $w.ctxm -tearoff 0
3419        $w.ctxm add command -label "Copy Commit" \
3420                -font font_ui \
3421                -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3422
3423        foreach i [list \
3424                $w.out.loaded_t \
3425                $w.out.linenumber_t \
3426                $w.out.file_t] {
3427                $i tag conf in_sel \
3428                        -background [$i cget -foreground] \
3429                        -foreground [$i cget -background]
3430                $i conf -yscrollcommand \
3431                        [list many2scrollbar [list \
3432                        $w.out.loaded_t \
3433                        $w.out.linenumber_t \
3434                        $w.out.file_t \
3435                        ] yview $w.out.sby]
3436                bind $i <Button-1> "
3437                        blame_click {$w} \\
3438                                $w.cm.t \\
3439                                $w.out.linenumber_t \\
3440                                $w.out.file_t \\
3441                                $i @%x,%y
3442                        focus $i
3443                "
3444                bind_button3 $i "
3445                        set cursorX %x
3446                        set cursorY %y
3447                        set cursorW %W
3448                        tk_popup $w.ctxm %X %Y
3449                "
3450        }
3451
3452        bind $w.cm.t <Button-1> "focus $w.cm.t"
3453        bind $tl <Visibility> "focus $tl"
3454        bind $tl <Destroy> "
3455                array unset blame_status {$w}
3456                array unset blame_data $w,*
3457        "
3458        wm title $tl "[appname] ([reponame]): File Viewer"
3459
3460        set blame_data($w,commit_count) 0
3461        set blame_data($w,commit_list) {}
3462        set blame_data($w,total_lines) 0
3463        set blame_data($w,blame_lines) 0
3464        set blame_data($w,highlight_commit) {}
3465        set blame_data($w,highlight_line) -1
3466
3467        set cmd [list git cat-file blob "$commit:$path"]
3468        set fd [open "| $cmd" r]
3469        fconfigure $fd -blocking 0 -translation lf -encoding binary
3470        fileevent $fd readable [list read_blame_catfile \
3471                $fd $w $commit $path \
3472                $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3473}
3474
3475proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3476        global blame_status blame_data
3477
3478        if {![winfo exists $w_file]} {
3479                catch {close $fd}
3480                return
3481        }
3482
3483        set n $blame_data($w,total_lines)
3484        $w_load conf -state normal
3485        $w_line conf -state normal
3486        $w_file conf -state normal
3487        while {[gets $fd line] >= 0} {
3488                regsub "\r\$" $line {} line
3489                incr n
3490                $w_load insert end "\n"
3491                $w_line insert end "$n\n" linenumber
3492                $w_file insert end "$line\n"
3493        }
3494        $w_load conf -state disabled
3495        $w_line conf -state disabled
3496        $w_file conf -state disabled
3497        set blame_data($w,total_lines) $n
3498
3499        if {[eof $fd]} {
3500                close $fd
3501                blame_incremental_status $w
3502                set cmd [list git blame -M -C --incremental]
3503                lappend cmd $commit -- $path
3504                set fd [open "| $cmd" r]
3505                fconfigure $fd -blocking 0 -translation lf -encoding binary
3506                fileevent $fd readable [list read_blame_incremental $fd $w \
3507                        $w_load $w_cmit $w_line $w_file]
3508        }
3509}
3510
3511proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3512        global blame_status blame_data
3513
3514        if {![winfo exists $w_file]} {
3515                catch {close $fd}
3516                return
3517        }
3518
3519        while {[gets $fd line] >= 0} {
3520                if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3521                        cmit original_line final_line line_count]} {
3522                        set blame_data($w,commit) $cmit
3523                        set blame_data($w,original_line) $original_line
3524                        set blame_data($w,final_line) $final_line
3525                        set blame_data($w,line_count) $line_count
3526
3527                        if {[catch {set g $blame_data($w,$cmit,order)}]} {
3528                                $w_line tag conf g$cmit
3529                                $w_file tag conf g$cmit
3530                                $w_line tag raise in_sel
3531                                $w_file tag raise in_sel
3532                                $w_file tag raise sel
3533                                set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3534                                incr blame_data($w,commit_count)
3535                                lappend blame_data($w,commit_list) $cmit
3536                        }
3537                } elseif {[string match {filename *} $line]} {
3538                        set file [string range $line 9 end]
3539                        set n $blame_data($w,line_count)
3540                        set lno $blame_data($w,final_line)
3541                        set cmit $blame_data($w,commit)
3542
3543                        while {$n > 0} {
3544                                if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3545                                        $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3546                                } else {
3547                                        $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3548                                        $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3549                                }
3550
3551                                set blame_data($w,line$lno,commit) $cmit
3552                                set blame_data($w,line$lno,file) $file
3553                                $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3554                                $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3555
3556                                if {$blame_data($w,highlight_line) == -1} {
3557                                        if {[lindex [$w_file yview] 0] == 0} {
3558                                                $w_file see $lno.0
3559                                                blame_showcommit $w $w_cmit $w_line $w_file $lno
3560                                        }
3561                                } elseif {$blame_data($w,highlight_line) == $lno} {
3562                                        blame_showcommit $w $w_cmit $w_line $w_file $lno
3563                                }
3564
3565                                incr n -1
3566                                incr lno
3567                                incr blame_data($w,blame_lines)
3568                        }
3569
3570                        set hc $blame_data($w,highlight_commit)
3571                        if {$hc ne {}
3572                                && [expr {$blame_data($w,$hc,order) + 1}]
3573                                        == $blame_data($w,$cmit,order)} {
3574                                blame_showcommit $w $w_cmit $w_line $w_file \
3575                                        $blame_data($w,highlight_line)
3576                        }
3577                } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3578                        set blame_data($w,$blame_data($w,commit),$header) $data
3579                }
3580        }
3581
3582        if {[eof $fd]} {
3583                close $fd
3584                set blame_status($w) {Annotation complete.}
3585        } else {
3586                blame_incremental_status $w
3587        }
3588}
3589
3590proc blame_incremental_status {w} {
3591        global blame_status blame_data
3592
3593        set blame_status($w) [format \
3594                "Loading annotations... %i of %i lines annotated (%2i%%)" \
3595                $blame_data($w,blame_lines) \
3596                $blame_data($w,total_lines) \
3597                [expr {100 * $blame_data($w,blame_lines)
3598                        / $blame_data($w,total_lines)}]]
3599}
3600
3601proc blame_click {w w_cmit w_line w_file cur_w pos} {
3602        set lno [lindex [split [$cur_w index $pos] .] 0]
3603        if {$lno eq {}} return
3604
3605        $w_line tag remove in_sel 0.0 end
3606        $w_file tag remove in_sel 0.0 end
3607        $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3608        $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3609
3610        blame_showcommit $w $w_cmit $w_line $w_file $lno
3611}
3612
3613set blame_colors {
3614        #ff4040
3615        #ff40ff
3616        #4040ff
3617}
3618
3619proc blame_showcommit {w w_cmit w_line w_file lno} {
3620        global blame_colors blame_data repo_config
3621
3622        set cmit $blame_data($w,highlight_commit)
3623        if {$cmit ne {}} {
3624                set idx $blame_data($w,$cmit,order)
3625                set i 0
3626                foreach c $blame_colors {
3627                        set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3628                        $w_line tag conf g$h -background white
3629                        $w_file tag conf g$h -background white
3630                        incr i
3631                }
3632        }
3633
3634        $w_cmit conf -state normal
3635        $w_cmit delete 0.0 end
3636        if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3637                set cmit {}
3638                $w_cmit insert end "Loading annotation..."
3639        } else {
3640                set idx $blame_data($w,$cmit,order)
3641                set i 0
3642                foreach c $blame_colors {
3643                        set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3644                        $w_line tag conf g$h -background $c
3645                        $w_file tag conf g$h -background $c
3646                        incr i
3647                }
3648
3649                if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3650                        set msg {}
3651                        catch {
3652                                set fd [open "| git cat-file commit $cmit" r]
3653                                fconfigure $fd -encoding binary -translation lf
3654                                if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3655                                        set enc utf-8
3656                                }
3657                                while {[gets $fd line] > 0} {
3658                                        if {[string match {encoding *} $line]} {
3659                                                set enc [string tolower [string range $line 9 end]]
3660                                        }
3661                                }
3662                                fconfigure $fd -encoding $enc
3663                                set msg [string trim [read $fd]]
3664                                close $fd
3665                        }
3666                        set blame_data($w,$cmit,message) $msg
3667                }
3668
3669                set author_name {}
3670                set author_email {}
3671                set author_time {}
3672                catch {set author_name $blame_data($w,$cmit,author)}
3673                catch {set author_email $blame_data($w,$cmit,author-mail)}
3674                catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3675
3676                set committer_name {}
3677                set committer_email {}
3678                set committer_time {}
3679                catch {set committer_name $blame_data($w,$cmit,committer)}
3680                catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3681                catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3682
3683                $w_cmit insert end "commit $cmit\n"
3684                $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3685                $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3686                $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3687                $w_cmit insert end "\n"
3688                $w_cmit insert end $msg
3689        }
3690        $w_cmit conf -state disabled
3691
3692        set blame_data($w,highlight_line) $lno
3693        set blame_data($w,highlight_commit) $cmit
3694}
3695
3696proc blame_copycommit {w i pos} {
3697        global blame_data
3698        set lno [lindex [split [$i index $pos] .] 0]
3699        if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3700                clipboard clear
3701                clipboard append \
3702                        -format STRING \
3703                        -type STRING \
3704                        -- $commit
3705        }
3706}
3707
3708######################################################################
3709##
3710## icons
3711
3712set filemask {
3713#define mask_width 14
3714#define mask_height 15
3715static unsigned char mask_bits[] = {
3716   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3717   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3718   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3719}
3720
3721image create bitmap file_plain -background white -foreground black -data {
3722#define plain_width 14
3723#define plain_height 15
3724static unsigned char plain_bits[] = {
3725   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3726   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3727   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3728} -maskdata $filemask
3729
3730image create bitmap file_mod -background white -foreground blue -data {
3731#define mod_width 14
3732#define mod_height 15
3733static unsigned char mod_bits[] = {
3734   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3735   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3736   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3737} -maskdata $filemask
3738
3739image create bitmap file_fulltick -background white -foreground "#007000" -data {
3740#define file_fulltick_width 14
3741#define file_fulltick_height 15
3742static unsigned char file_fulltick_bits[] = {
3743   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3744   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3745   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3746} -maskdata $filemask
3747
3748image create bitmap file_parttick -background white -foreground "#005050" -data {
3749#define parttick_width 14
3750#define parttick_height 15
3751static unsigned char parttick_bits[] = {
3752   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3753   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3754   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3755} -maskdata $filemask
3756
3757image create bitmap file_question -background white -foreground black -data {
3758#define file_question_width 14
3759#define file_question_height 15
3760static unsigned char file_question_bits[] = {
3761   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3762   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3763   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764} -maskdata $filemask
3765
3766image create bitmap file_removed -background white -foreground red -data {
3767#define file_removed_width 14
3768#define file_removed_height 15
3769static unsigned char file_removed_bits[] = {
3770   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3771   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3772   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3773} -maskdata $filemask
3774
3775image create bitmap file_merge -background white -foreground blue -data {
3776#define file_merge_width 14
3777#define file_merge_height 15
3778static unsigned char file_merge_bits[] = {
3779   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3780   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3781   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3782} -maskdata $filemask
3783
3784set file_dir_data {
3785#define file_width 18
3786#define file_height 18
3787static unsigned char file_bits[] = {
3788  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3789  0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3790  0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3791  0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3792  0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3793}
3794image create bitmap file_dir -background white -foreground blue \
3795        -data $file_dir_data -maskdata $file_dir_data
3796unset file_dir_data
3797
3798set file_uplevel_data {
3799#define up_width 15
3800#define up_height 15
3801static unsigned char up_bits[] = {
3802  0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3803  0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3804  0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3805}
3806image create bitmap file_uplevel -background white -foreground red \
3807        -data $file_uplevel_data -maskdata $file_uplevel_data
3808unset file_uplevel_data
3809
3810set ui_index .vpane.files.index.list
3811set ui_workdir .vpane.files.workdir.list
3812
3813set all_icons(_$ui_index)   file_plain
3814set all_icons(A$ui_index)   file_fulltick
3815set all_icons(M$ui_index)   file_fulltick
3816set all_icons(D$ui_index)   file_removed
3817set all_icons(U$ui_index)   file_merge
3818
3819set all_icons(_$ui_workdir) file_plain
3820set all_icons(M$ui_workdir) file_mod
3821set all_icons(D$ui_workdir) file_question
3822set all_icons(U$ui_workdir) file_merge
3823set all_icons(O$ui_workdir) file_plain
3824
3825set max_status_desc 0
3826foreach i {
3827                {__ "Unmodified"}
3828
3829                {_M "Modified, not staged"}
3830                {M_ "Staged for commit"}
3831                {MM "Portions staged for commit"}
3832                {MD "Staged for commit, missing"}
3833
3834                {_O "Untracked, not staged"}
3835                {A_ "Staged for commit"}
3836                {AM "Portions staged for commit"}
3837                {AD "Staged for commit, missing"}
3838
3839                {_D "Missing"}
3840                {D_ "Staged for removal"}
3841                {DO "Staged for removal, still present"}
3842
3843                {U_ "Requires merge resolution"}
3844                {UU "Requires merge resolution"}
3845                {UM "Requires merge resolution"}
3846                {UD "Requires merge resolution"}
3847        } {
3848        if {$max_status_desc < [string length [lindex $i 1]]} {
3849                set max_status_desc [string length [lindex $i 1]]
3850        }
3851        set all_descs([lindex $i 0]) [lindex $i 1]
3852}
3853unset i
3854
3855######################################################################
3856##
3857## util
3858
3859proc bind_button3 {w cmd} {
3860        bind $w <Any-Button-3> $cmd
3861        if {[is_MacOSX]} {
3862                bind $w <Control-Button-1> $cmd
3863        }
3864}
3865
3866proc scrollbar2many {list mode args} {
3867        foreach w $list {eval $w $mode $args}
3868}
3869
3870proc many2scrollbar {list mode sb top bottom} {
3871        $sb set $top $bottom
3872        foreach w $list {$w $mode moveto $top}
3873}
3874
3875proc incr_font_size {font {amt 1}} {
3876        set sz [font configure $font -size]
3877        incr sz $amt
3878        font configure $font -size $sz
3879        font configure ${font}bold -size $sz
3880}
3881
3882proc hook_failed_popup {hook msg} {
3883        set w .hookfail
3884        toplevel $w
3885
3886        frame $w.m
3887        label $w.m.l1 -text "$hook hook failed:" \
3888                -anchor w \
3889                -justify left \
3890                -font font_uibold
3891        text $w.m.t \
3892                -background white -borderwidth 1 \
3893                -relief sunken \
3894                -width 80 -height 10 \
3895                -font font_diff \
3896                -yscrollcommand [list $w.m.sby set]
3897        label $w.m.l2 \
3898                -text {You must correct the above errors before committing.} \
3899                -anchor w \
3900                -justify left \
3901                -font font_uibold
3902        scrollbar $w.m.sby -command [list $w.m.t yview]
3903        pack $w.m.l1 -side top -fill x
3904        pack $w.m.l2 -side bottom -fill x
3905        pack $w.m.sby -side right -fill y
3906        pack $w.m.t -side left -fill both -expand 1
3907        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3908
3909        $w.m.t insert 1.0 $msg
3910        $w.m.t conf -state disabled
3911
3912        button $w.ok -text OK \
3913                -width 15 \
3914                -font font_ui \
3915                -command "destroy $w"
3916        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3917
3918        bind $w <Visibility> "grab $w; focus $w"
3919        bind $w <Key-Return> "destroy $w"
3920        wm title $w "[appname] ([reponame]): error"
3921        tkwait window $w
3922}
3923
3924set next_console_id 0
3925
3926proc new_console {short_title long_title} {
3927        global next_console_id console_data
3928        set w .console[incr next_console_id]
3929        set console_data($w) [list $short_title $long_title]
3930        return [console_init $w]
3931}
3932
3933proc console_init {w} {
3934        global console_cr console_data M1B
3935
3936        set console_cr($w) 1.0
3937        toplevel $w
3938        frame $w.m
3939        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3940                -anchor w \
3941                -justify left \
3942                -font font_uibold
3943        text $w.m.t \
3944                -background white -borderwidth 1 \
3945                -relief sunken \
3946                -width 80 -height 10 \
3947                -font font_diff \
3948                -state disabled \
3949                -yscrollcommand [list $w.m.sby set]
3950        label $w.m.s -text {Working... please wait...} \
3951                -anchor w \
3952                -justify left \
3953                -font font_uibold
3954        scrollbar $w.m.sby -command [list $w.m.t yview]
3955        pack $w.m.l1 -side top -fill x
3956        pack $w.m.s -side bottom -fill x
3957        pack $w.m.sby -side right -fill y
3958        pack $w.m.t -side left -fill both -expand 1
3959        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3960
3961        menu $w.ctxm -tearoff 0
3962        $w.ctxm add command -label "Copy" \
3963                -font font_ui \
3964                -command "tk_textCopy $w.m.t"
3965        $w.ctxm add command -label "Select All" \
3966                -font font_ui \
3967                -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3968        $w.ctxm add command -label "Copy All" \
3969                -font font_ui \
3970                -command "
3971                        $w.m.t tag add sel 0.0 end
3972                        tk_textCopy $w.m.t
3973                        $w.m.t tag remove sel 0.0 end
3974                "
3975
3976        button $w.ok -text {Close} \
3977                -font font_ui \
3978                -state disabled \
3979                -command "destroy $w"
3980        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3981
3982        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3983        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3984        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3985        bind $w <Visibility> "focus $w"
3986        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3987        return $w
3988}
3989
3990proc console_exec {w cmd after} {
3991        # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3992        #    But most users need that so we have to relogin. :-(
3993        #
3994        if {[is_Cygwin]} {
3995                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3996        }
3997
3998        # -- Tcl won't let us redirect both stdout and stderr to
3999        #    the same pipe.  So pass it through cat...
4000        #
4001        set cmd [concat | $cmd |& cat]
4002
4003        set fd_f [open $cmd r]
4004        fconfigure $fd_f -blocking 0 -translation binary
4005        fileevent $fd_f readable [list console_read $w $fd_f $after]
4006}
4007
4008proc console_read {w fd after} {
4009        global console_cr
4010
4011        set buf [read $fd]
4012        if {$buf ne {}} {
4013                if {![winfo exists $w]} {console_init $w}
4014                $w.m.t conf -state normal
4015                set c 0
4016                set n [string length $buf]
4017                while {$c < $n} {
4018                        set cr [string first "\r" $buf $c]
4019                        set lf [string first "\n" $buf $c]
4020                        if {$cr < 0} {set cr [expr {$n + 1}]}
4021                        if {$lf < 0} {set lf [expr {$n + 1}]}
4022
4023                        if {$lf < $cr} {
4024                                $w.m.t insert end [string range $buf $c $lf]
4025                                set console_cr($w) [$w.m.t index {end -1c}]
4026                                set c $lf
4027                                incr c
4028                        } else {
4029                                $w.m.t delete $console_cr($w) end
4030                                $w.m.t insert end "\n"
4031                                $w.m.t insert end [string range $buf $c $cr]
4032                                set c $cr
4033                                incr c
4034                        }
4035                }
4036                $w.m.t conf -state disabled
4037                $w.m.t see end
4038        }
4039
4040        fconfigure $fd -blocking 1
4041        if {[eof $fd]} {
4042                if {[catch {close $fd}]} {
4043                        set ok 0
4044                } else {
4045                        set ok 1
4046                }
4047                uplevel #0 $after $w $ok
4048                return
4049        }
4050        fconfigure $fd -blocking 0
4051}
4052
4053proc console_chain {cmdlist w {ok 1}} {
4054        if {$ok} {
4055                if {[llength $cmdlist] == 0} {
4056                        console_done $w $ok
4057                        return
4058                }
4059
4060                set cmd [lindex $cmdlist 0]
4061                set cmdlist [lrange $cmdlist 1 end]
4062
4063                if {[lindex $cmd 0] eq {console_exec}} {
4064                        console_exec $w \
4065                                [lindex $cmd 1] \
4066                                [list console_chain $cmdlist]
4067                } else {
4068                        uplevel #0 $cmd $cmdlist $w $ok
4069                }
4070        } else {
4071                console_done $w $ok
4072        }
4073}
4074
4075proc console_done {args} {
4076        global console_cr console_data
4077
4078        switch -- [llength $args] {
4079        2 {
4080                set w [lindex $args 0]
4081                set ok [lindex $args 1]
4082        }
4083        3 {
4084                set w [lindex $args 1]
4085                set ok [lindex $args 2]
4086        }
4087        default {
4088                error "wrong number of args: console_done ?ignored? w ok"
4089        }
4090        }
4091
4092        if {$ok} {
4093                if {[winfo exists $w]} {
4094                        $w.m.s conf -background green -text {Success}
4095                        $w.ok conf -state normal
4096                }
4097        } else {
4098                if {![winfo exists $w]} {
4099                        console_init $w
4100                }
4101                $w.m.s conf -background red -text {Error: Command Failed}
4102                $w.ok conf -state normal
4103        }
4104
4105        array unset console_cr $w
4106        array unset console_data $w
4107}
4108
4109######################################################################
4110##
4111## ui commands
4112
4113set starting_gitk_msg {Starting gitk... please wait...}
4114
4115proc do_gitk {revs} {
4116        global env ui_status_value starting_gitk_msg
4117
4118        # -- Always start gitk through whatever we were loaded with.  This
4119        #    lets us bypass using shell process on Windows systems.
4120        #
4121        set cmd [info nameofexecutable]
4122        lappend cmd [gitexec gitk]
4123        if {$revs ne {}} {
4124                append cmd { }
4125                append cmd $revs
4126        }
4127
4128        if {[catch {eval exec $cmd &} err]} {
4129                error_popup "Failed to start gitk:\n\n$err"
4130        } else {
4131                set ui_status_value $starting_gitk_msg
4132                after 10000 {
4133                        if {$ui_status_value eq $starting_gitk_msg} {
4134                                set ui_status_value {Ready.}
4135                        }
4136                }
4137        }
4138}
4139
4140proc do_stats {} {
4141        set fd [open "| git count-objects -v" r]
4142        while {[gets $fd line] > 0} {
4143                if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4144                        set stats($name) $value
4145                }
4146        }
4147        close $fd
4148
4149        set packed_sz 0
4150        foreach p [glob -directory [gitdir objects pack] \
4151                -type f \
4152                -nocomplain -- *] {
4153                incr packed_sz [file size $p]
4154        }
4155        if {$packed_sz > 0} {
4156                set stats(size-pack) [expr {$packed_sz / 1024}]
4157        }
4158
4159        set w .stats_view
4160        toplevel $w
4161        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4162
4163        label $w.header -text {Database Statistics} \
4164                -font font_uibold
4165        pack $w.header -side top -fill x
4166
4167        frame $w.buttons -border 1
4168        button $w.buttons.close -text Close \
4169                -font font_ui \
4170                -command [list destroy $w]
4171        button $w.buttons.gc -text {Compress Database} \
4172                -font font_ui \
4173                -command "destroy $w;do_gc"
4174        pack $w.buttons.close -side right
4175        pack $w.buttons.gc -side left
4176        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4177
4178        frame $w.stat -borderwidth 1 -relief solid
4179        foreach s {
4180                {count           {Number of loose objects}}
4181                {size            {Disk space used by loose objects} { KiB}}
4182                {in-pack         {Number of packed objects}}
4183                {packs           {Number of packs}}
4184                {size-pack       {Disk space used by packed objects} { KiB}}
4185                {prune-packable  {Packed objects waiting for pruning}}
4186                {garbage         {Garbage files}}
4187                } {
4188                set name [lindex $s 0]
4189                set label [lindex $s 1]
4190                if {[catch {set value $stats($name)}]} continue
4191                if {[llength $s] > 2} {
4192                        set value "$value[lindex $s 2]"
4193                }
4194
4195                label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4196                label $w.stat.v_$name -text $value -anchor w -font font_ui
4197                grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4198        }
4199        pack $w.stat -pady 10 -padx 10
4200
4201        bind $w <Visibility> "grab $w; focus $w"
4202        bind $w <Key-Escape> [list destroy $w]
4203        bind $w <Key-Return> [list destroy $w]
4204        wm title $w "[appname] ([reponame]): Database Statistics"
4205        tkwait window $w
4206}
4207
4208proc do_gc {} {
4209        set w [new_console {gc} {Compressing the object database}]
4210        console_chain {
4211                {console_exec {git pack-refs --prune}}
4212                {console_exec {git reflog expire --all}}
4213                {console_exec {git repack -a -d -l}}
4214                {console_exec {git rerere gc}}
4215        } $w
4216}
4217
4218proc do_fsck_objects {} {
4219        set w [new_console {fsck-objects} \
4220                {Verifying the object database with fsck-objects}]
4221        set cmd [list git fsck-objects]
4222        lappend cmd --full
4223        lappend cmd --cache
4224        lappend cmd --strict
4225        console_exec $w $cmd console_done
4226}
4227
4228set is_quitting 0
4229
4230proc do_quit {} {
4231        global ui_comm is_quitting repo_config commit_type
4232
4233        if {$is_quitting} return
4234        set is_quitting 1
4235
4236        if {[winfo exists $ui_comm]} {
4237                # -- Stash our current commit buffer.
4238                #
4239                set save [gitdir GITGUI_MSG]
4240                set msg [string trim [$ui_comm get 0.0 end]]
4241                regsub -all -line {[ \r\t]+$} $msg {} msg
4242                if {(![string match amend* $commit_type]
4243                        || [$ui_comm edit modified])
4244                        && $msg ne {}} {
4245                        catch {
4246                                set fd [open $save w]
4247                                puts -nonewline $fd $msg
4248                                close $fd
4249                        }
4250                } else {
4251                        catch {file delete $save}
4252                }
4253
4254                # -- Stash our current window geometry into this repository.
4255                #
4256                set cfg_geometry [list]
4257                lappend cfg_geometry [wm geometry .]
4258                lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4259                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4260                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4261                        set rc_geometry {}
4262                }
4263                if {$cfg_geometry ne $rc_geometry} {
4264                        catch {git config gui.geometry $cfg_geometry}
4265                }
4266        }
4267
4268        destroy .
4269}
4270
4271proc do_rescan {} {
4272        rescan {set ui_status_value {Ready.}}
4273}
4274
4275proc unstage_helper {txt paths} {
4276        global file_states current_diff_path
4277
4278        if {![lock_index begin-update]} return
4279
4280        set pathList [list]
4281        set after {}
4282        foreach path $paths {
4283                switch -glob -- [lindex $file_states($path) 0] {
4284                A? -
4285                M? -
4286                D? {
4287                        lappend pathList $path
4288                        if {$path eq $current_diff_path} {
4289                                set after {reshow_diff;}
4290                        }
4291                }
4292                }
4293        }
4294        if {$pathList eq {}} {
4295                unlock_index
4296        } else {
4297                update_indexinfo \
4298                        $txt \
4299                        $pathList \
4300                        [concat $after {set ui_status_value {Ready.}}]
4301        }
4302}
4303
4304proc do_unstage_selection {} {
4305        global current_diff_path selected_paths
4306
4307        if {[array size selected_paths] > 0} {
4308                unstage_helper \
4309                        {Unstaging selected files from commit} \
4310                        [array names selected_paths]
4311        } elseif {$current_diff_path ne {}} {
4312                unstage_helper \
4313                        "Unstaging [short_path $current_diff_path] from commit" \
4314                        [list $current_diff_path]
4315        }
4316}
4317
4318proc add_helper {txt paths} {
4319        global file_states current_diff_path
4320
4321        if {![lock_index begin-update]} return
4322
4323        set pathList [list]
4324        set after {}
4325        foreach path $paths {
4326                switch -glob -- [lindex $file_states($path) 0] {
4327                _O -
4328                ?M -
4329                ?D -
4330                U? {
4331                        lappend pathList $path
4332                        if {$path eq $current_diff_path} {
4333                                set after {reshow_diff;}
4334                        }
4335                }
4336                }
4337        }
4338        if {$pathList eq {}} {
4339                unlock_index
4340        } else {
4341                update_index \
4342                        $txt \
4343                        $pathList \
4344                        [concat $after {set ui_status_value {Ready to commit.}}]
4345        }
4346}
4347
4348proc do_add_selection {} {
4349        global current_diff_path selected_paths
4350
4351        if {[array size selected_paths] > 0} {
4352                add_helper \
4353                        {Adding selected files} \
4354                        [array names selected_paths]
4355        } elseif {$current_diff_path ne {}} {
4356                add_helper \
4357                        "Adding [short_path $current_diff_path]" \
4358                        [list $current_diff_path]
4359        }
4360}
4361
4362proc do_add_all {} {
4363        global file_states
4364
4365        set paths [list]
4366        foreach path [array names file_states] {
4367                switch -glob -- [lindex $file_states($path) 0] {
4368                U? {continue}
4369                ?M -
4370                ?D {lappend paths $path}
4371                }
4372        }
4373        add_helper {Adding all changed files} $paths
4374}
4375
4376proc revert_helper {txt paths} {
4377        global file_states current_diff_path
4378
4379        if {![lock_index begin-update]} return
4380
4381        set pathList [list]
4382        set after {}
4383        foreach path $paths {
4384                switch -glob -- [lindex $file_states($path) 0] {
4385                U? {continue}
4386                ?M -
4387                ?D {
4388                        lappend pathList $path
4389                        if {$path eq $current_diff_path} {
4390                                set after {reshow_diff;}
4391                        }
4392                }
4393                }
4394        }
4395
4396        set n [llength $pathList]
4397        if {$n == 0} {
4398                unlock_index
4399                return
4400        } elseif {$n == 1} {
4401                set s "[short_path [lindex $pathList]]"
4402        } else {
4403                set s "these $n files"
4404        }
4405
4406        set reply [tk_dialog \
4407                .confirm_revert \
4408                "[appname] ([reponame])" \
4409                "Revert changes in $s?
4410
4411Any unadded changes will be permanently lost by the revert." \
4412                question \
4413                1 \
4414                {Do Nothing} \
4415                {Revert Changes} \
4416                ]
4417        if {$reply == 1} {
4418                checkout_index \
4419                        $txt \
4420                        $pathList \
4421                        [concat $after {set ui_status_value {Ready.}}]
4422        } else {
4423                unlock_index
4424        }
4425}
4426
4427proc do_revert_selection {} {
4428        global current_diff_path selected_paths
4429
4430        if {[array size selected_paths] > 0} {
4431                revert_helper \
4432                        {Reverting selected files} \
4433                        [array names selected_paths]
4434        } elseif {$current_diff_path ne {}} {
4435                revert_helper \
4436                        "Reverting [short_path $current_diff_path]" \
4437                        [list $current_diff_path]
4438        }
4439}
4440
4441proc do_signoff {} {
4442        global ui_comm
4443
4444        set me [committer_ident]
4445        if {$me eq {}} return
4446
4447        set sob "Signed-off-by: $me"
4448        set last [$ui_comm get {end -1c linestart} {end -1c}]
4449        if {$last ne $sob} {
4450                $ui_comm edit separator
4451                if {$last ne {}
4452                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4453                        $ui_comm insert end "\n"
4454                }
4455                $ui_comm insert end "\n$sob"
4456                $ui_comm edit separator
4457                $ui_comm see end
4458        }
4459}
4460
4461proc do_select_commit_type {} {
4462        global commit_type selected_commit_type
4463
4464        if {$selected_commit_type eq {new}
4465                && [string match amend* $commit_type]} {
4466                create_new_commit
4467        } elseif {$selected_commit_type eq {amend}
4468                && ![string match amend* $commit_type]} {
4469                load_last_commit
4470
4471                # The amend request was rejected...
4472                #
4473                if {![string match amend* $commit_type]} {
4474                        set selected_commit_type new
4475                }
4476        }
4477}
4478
4479proc do_commit {} {
4480        commit_tree
4481}
4482
4483proc do_credits {} {
4484        global gitgui_credits
4485
4486        set w .credits_dialog
4487
4488        toplevel $w
4489        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4490
4491        label $w.header -text {git-gui Contributors} -font font_uibold
4492        pack $w.header -side top -fill x
4493
4494        frame $w.buttons
4495        button $w.buttons.close -text {Close} \
4496                -font font_ui \
4497                -command [list destroy $w]
4498        pack $w.buttons.close -side right
4499        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4500
4501        frame $w.credits
4502        text $w.credits.t \
4503                -background [$w.header cget -background] \
4504                -yscrollcommand [list $w.credits.sby set] \
4505                -width 20 \
4506                -height 10 \
4507                -wrap none \
4508                -borderwidth 1 \
4509                -relief solid \
4510                -padx 5 -pady 5 \
4511                -font font_ui
4512        scrollbar $w.credits.sby -command [list $w.credits.t yview]
4513        pack $w.credits.sby -side right -fill y
4514        pack $w.credits.t -fill both -expand 1
4515        pack $w.credits -side top -fill both -expand 1 -padx 5 -pady 5
4516
4517        label $w.desc \
4518                -text "All portions are copyrighted by their respective authors
4519and are distributed under the GNU General Public License." \
4520                -padx 5 -pady 5 \
4521                -justify left \
4522                -anchor w \
4523                -borderwidth 1 \
4524                -relief solid \
4525                -font font_ui
4526        pack $w.desc -side top -fill x -padx 5 -pady 5
4527
4528        $w.credits.t insert end "[string trim $gitgui_credits]\n"
4529        $w.credits.t conf -state disabled
4530        $w.credits.t see 1.0
4531
4532        bind $w <Visibility> "grab $w; focus $w"
4533        bind $w <Key-Escape> [list destroy $w]
4534        wm title $w [$w.header cget -text]
4535        tkwait window $w
4536}
4537
4538proc do_about {} {
4539        global appvers copyright
4540        global tcl_patchLevel tk_patchLevel
4541
4542        set w .about_dialog
4543        toplevel $w
4544        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4545
4546        label $w.header -text "About [appname]" \
4547                -font font_uibold
4548        pack $w.header -side top -fill x
4549
4550        frame $w.buttons
4551        button $w.buttons.close -text {Close} \
4552                -font font_ui \
4553                -command [list destroy $w]
4554        button $w.buttons.credits -text {Contributors} \
4555                -font font_ui \
4556                -command do_credits
4557        pack $w.buttons.credits -side left
4558        pack $w.buttons.close -side right
4559        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4560
4561        label $w.desc \
4562                -text "git-gui - a graphical user interface for Git.
4563$copyright" \
4564                -padx 5 -pady 5 \
4565                -justify left \
4566                -anchor w \
4567                -borderwidth 1 \
4568                -relief solid \
4569                -font font_ui
4570        pack $w.desc -side top -fill x -padx 5 -pady 5
4571
4572        set v {}
4573        append v "git-gui version $appvers\n"
4574        append v "[git version]\n"
4575        append v "\n"
4576        if {$tcl_patchLevel eq $tk_patchLevel} {
4577                append v "Tcl/Tk version $tcl_patchLevel"
4578        } else {
4579                append v "Tcl version $tcl_patchLevel"
4580                append v ", Tk version $tk_patchLevel"
4581        }
4582
4583        label $w.vers \
4584                -text $v \
4585                -padx 5 -pady 5 \
4586                -justify left \
4587                -anchor w \
4588                -borderwidth 1 \
4589                -relief solid \
4590                -font font_ui
4591        pack $w.vers -side top -fill x -padx 5 -pady 5
4592
4593        menu $w.ctxm -tearoff 0
4594        $w.ctxm add command \
4595                -label {Copy} \
4596                -font font_ui \
4597                -command "
4598                clipboard clear
4599                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4600        "
4601
4602        bind $w <Visibility> "grab $w; focus $w"
4603        bind $w <Key-Escape> "destroy $w"
4604        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4605        wm title $w "About [appname]"
4606        tkwait window $w
4607}
4608
4609proc do_options {} {
4610        global repo_config global_config font_descs
4611        global repo_config_new global_config_new
4612
4613        array unset repo_config_new
4614        array unset global_config_new
4615        foreach name [array names repo_config] {
4616                set repo_config_new($name) $repo_config($name)
4617        }
4618        load_config 1
4619        foreach name [array names repo_config] {
4620                switch -- $name {
4621                gui.diffcontext {continue}
4622                }
4623                set repo_config_new($name) $repo_config($name)
4624        }
4625        foreach name [array names global_config] {
4626                set global_config_new($name) $global_config($name)
4627        }
4628
4629        set w .options_editor
4630        toplevel $w
4631        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4632
4633        label $w.header -text "Options" \
4634                -font font_uibold
4635        pack $w.header -side top -fill x
4636
4637        frame $w.buttons
4638        button $w.buttons.restore -text {Restore Defaults} \
4639                -font font_ui \
4640                -command do_restore_defaults
4641        pack $w.buttons.restore -side left
4642        button $w.buttons.save -text Save \
4643                -font font_ui \
4644                -command [list do_save_config $w]
4645        pack $w.buttons.save -side right
4646        button $w.buttons.cancel -text {Cancel} \
4647                -font font_ui \
4648                -command [list destroy $w]
4649        pack $w.buttons.cancel -side right -padx 5
4650        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4651
4652        labelframe $w.repo -text "[reponame] Repository" \
4653                -font font_ui
4654        labelframe $w.global -text {Global (All Repositories)} \
4655                -font font_ui
4656        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4657        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4658
4659        set optid 0
4660        foreach option {
4661                {t user.name {User Name}}
4662                {t user.email {Email Address}}
4663
4664                {b merge.summary {Summarize Merge Commits}}
4665                {i-1..5 merge.verbosity {Merge Verbosity}}
4666
4667                {b gui.trustmtime  {Trust File Modification Timestamps}}
4668                {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4669                {t gui.newbranchtemplate {New Branch Name Template}}
4670                } {
4671                set type [lindex $option 0]
4672                set name [lindex $option 1]
4673                set text [lindex $option 2]
4674                incr optid
4675                foreach f {repo global} {
4676                        switch -glob -- $type {
4677                        b {
4678                                checkbutton $w.$f.$optid -text $text \
4679                                        -variable ${f}_config_new($name) \
4680                                        -onvalue true \
4681                                        -offvalue false \
4682                                        -font font_ui
4683                                pack $w.$f.$optid -side top -anchor w
4684                        }
4685                        i-* {
4686                                regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4687                                frame $w.$f.$optid
4688                                label $w.$f.$optid.l -text "$text:" -font font_ui
4689                                pack $w.$f.$optid.l -side left -anchor w -fill x
4690                                spinbox $w.$f.$optid.v \
4691                                        -textvariable ${f}_config_new($name) \
4692                                        -from $min \
4693                                        -to $max \
4694                                        -increment 1 \
4695                                        -width [expr {1 + [string length $max]}] \
4696                                        -font font_ui
4697                                bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4698                                pack $w.$f.$optid.v -side right -anchor e -padx 5
4699                                pack $w.$f.$optid -side top -anchor w -fill x
4700                        }
4701                        t {
4702                                frame $w.$f.$optid
4703                                label $w.$f.$optid.l -text "$text:" -font font_ui
4704                                entry $w.$f.$optid.v \
4705                                        -borderwidth 1 \
4706                                        -relief sunken \
4707                                        -width 20 \
4708                                        -textvariable ${f}_config_new($name) \
4709                                        -font font_ui
4710                                pack $w.$f.$optid.l -side left -anchor w
4711                                pack $w.$f.$optid.v -side left -anchor w \
4712                                        -fill x -expand 1 \
4713                                        -padx 5
4714                                pack $w.$f.$optid -side top -anchor w -fill x
4715                        }
4716                        }
4717                }
4718        }
4719
4720        set all_fonts [lsort [font families]]
4721        foreach option $font_descs {
4722                set name [lindex $option 0]
4723                set font [lindex $option 1]
4724                set text [lindex $option 2]
4725
4726                set global_config_new(gui.$font^^family) \
4727                        [font configure $font -family]
4728                set global_config_new(gui.$font^^size) \
4729                        [font configure $font -size]
4730
4731                frame $w.global.$name
4732                label $w.global.$name.l -text "$text:" -font font_ui
4733                pack $w.global.$name.l -side left -anchor w -fill x
4734                eval tk_optionMenu $w.global.$name.family \
4735                        global_config_new(gui.$font^^family) \
4736                        $all_fonts
4737                spinbox $w.global.$name.size \
4738                        -textvariable global_config_new(gui.$font^^size) \
4739                        -from 2 -to 80 -increment 1 \
4740                        -width 3 \
4741                        -font font_ui
4742                bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4743                pack $w.global.$name.size -side right -anchor e
4744                pack $w.global.$name.family -side right -anchor e
4745                pack $w.global.$name -side top -anchor w -fill x
4746        }
4747
4748        bind $w <Visibility> "grab $w; focus $w"
4749        bind $w <Key-Escape> "destroy $w"
4750        wm title $w "[appname] ([reponame]): Options"
4751        tkwait window $w
4752}
4753
4754proc do_restore_defaults {} {
4755        global font_descs default_config repo_config
4756        global repo_config_new global_config_new
4757
4758        foreach name [array names default_config] {
4759                set repo_config_new($name) $default_config($name)
4760                set global_config_new($name) $default_config($name)
4761        }
4762
4763        foreach option $font_descs {
4764                set name [lindex $option 0]
4765                set repo_config(gui.$name) $default_config(gui.$name)
4766        }
4767        apply_config
4768
4769        foreach option $font_descs {
4770                set name [lindex $option 0]
4771                set font [lindex $option 1]
4772                set global_config_new(gui.$font^^family) \
4773                        [font configure $font -family]
4774                set global_config_new(gui.$font^^size) \
4775                        [font configure $font -size]
4776        }
4777}
4778
4779proc do_save_config {w} {
4780        if {[catch {save_config} err]} {
4781                error_popup "Failed to completely save options:\n\n$err"
4782        }
4783        reshow_diff
4784        destroy $w
4785}
4786
4787proc do_windows_shortcut {} {
4788        global argv0
4789
4790        set fn [tk_getSaveFile \
4791                -parent . \
4792                -title "[appname] ([reponame]): Create Desktop Icon" \
4793                -initialfile "Git [reponame].bat"]
4794        if {$fn != {}} {
4795                if {[catch {
4796                                set fd [open $fn w]
4797                                puts $fd "@ECHO Entering [reponame]"
4798                                puts $fd "@ECHO Starting git-gui... please wait..."
4799                                puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4800                                puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4801                                puts -nonewline $fd "@\"[info nameofexecutable]\""
4802                                puts $fd " \"[file normalize $argv0]\""
4803                                close $fd
4804                        } err]} {
4805                        error_popup "Cannot write script:\n\n$err"
4806                }
4807        }
4808}
4809
4810proc do_cygwin_shortcut {} {
4811        global argv0
4812
4813        if {[catch {
4814                set desktop [exec cygpath \
4815                        --windows \
4816                        --absolute \
4817                        --long-name \
4818                        --desktop]
4819                }]} {
4820                        set desktop .
4821        }
4822        set fn [tk_getSaveFile \
4823                -parent . \
4824                -title "[appname] ([reponame]): Create Desktop Icon" \
4825                -initialdir $desktop \
4826                -initialfile "Git [reponame].bat"]
4827        if {$fn != {}} {
4828                if {[catch {
4829                                set fd [open $fn w]
4830                                set sh [exec cygpath \
4831                                        --windows \
4832                                        --absolute \
4833                                        /bin/sh]
4834                                set me [exec cygpath \
4835                                        --unix \
4836                                        --absolute \
4837                                        $argv0]
4838                                set gd [exec cygpath \
4839                                        --unix \
4840                                        --absolute \
4841                                        [gitdir]]
4842                                set gw [exec cygpath \
4843                                        --windows \
4844                                        --absolute \
4845                                        [file dirname [gitdir]]]
4846                                regsub -all ' $me "'\\''" me
4847                                regsub -all ' $gd "'\\''" gd
4848                                puts $fd "@ECHO Entering $gw"
4849                                puts $fd "@ECHO Starting git-gui... please wait..."
4850                                puts -nonewline $fd "@\"$sh\" --login -c \""
4851                                puts -nonewline $fd "GIT_DIR='$gd'"
4852                                puts -nonewline $fd " '$me'"
4853                                puts $fd "&\""
4854                                close $fd
4855                        } err]} {
4856                        error_popup "Cannot write script:\n\n$err"
4857                }
4858        }
4859}
4860
4861proc do_macosx_app {} {
4862        global argv0 env
4863
4864        set fn [tk_getSaveFile \
4865                -parent . \
4866                -title "[appname] ([reponame]): Create Desktop Icon" \
4867                -initialdir [file join $env(HOME) Desktop] \
4868                -initialfile "Git [reponame].app"]
4869        if {$fn != {}} {
4870                if {[catch {
4871                                set Contents [file join $fn Contents]
4872                                set MacOS [file join $Contents MacOS]
4873                                set exe [file join $MacOS git-gui]
4874
4875                                file mkdir $MacOS
4876
4877                                set fd [open [file join $Contents Info.plist] w]
4878                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4879<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4880<plist version="1.0">
4881<dict>
4882        <key>CFBundleDevelopmentRegion</key>
4883        <string>English</string>
4884        <key>CFBundleExecutable</key>
4885        <string>git-gui</string>
4886        <key>CFBundleIdentifier</key>
4887        <string>org.spearce.git-gui</string>
4888        <key>CFBundleInfoDictionaryVersion</key>
4889        <string>6.0</string>
4890        <key>CFBundlePackageType</key>
4891        <string>APPL</string>
4892        <key>CFBundleSignature</key>
4893        <string>????</string>
4894        <key>CFBundleVersion</key>
4895        <string>1.0</string>
4896        <key>NSPrincipalClass</key>
4897        <string>NSApplication</string>
4898</dict>
4899</plist>}
4900                                close $fd
4901
4902                                set fd [open $exe w]
4903                                set gd [file normalize [gitdir]]
4904                                set ep [file normalize [gitexec]]
4905                                regsub -all ' $gd "'\\''" gd
4906                                regsub -all ' $ep "'\\''" ep
4907                                puts $fd "#!/bin/sh"
4908                                foreach name [array names env] {
4909                                        if {[string match GIT_* $name]} {
4910                                                regsub -all ' $env($name) "'\\''" v
4911                                                puts $fd "export $name='$v'"
4912                                        }
4913                                }
4914                                puts $fd "export PATH='$ep':\$PATH"
4915                                puts $fd "export GIT_DIR='$gd'"
4916                                puts $fd "exec [file normalize $argv0]"
4917                                close $fd
4918
4919                                file attributes $exe -permissions u+x,g+x,o+x
4920                        } err]} {
4921                        error_popup "Cannot write icon:\n\n$err"
4922                }
4923        }
4924}
4925
4926proc toggle_or_diff {w x y} {
4927        global file_states file_lists current_diff_path ui_index ui_workdir
4928        global last_clicked selected_paths
4929
4930        set pos [split [$w index @$x,$y] .]
4931        set lno [lindex $pos 0]
4932        set col [lindex $pos 1]
4933        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4934        if {$path eq {}} {
4935                set last_clicked {}
4936                return
4937        }
4938
4939        set last_clicked [list $w $lno]
4940        array unset selected_paths
4941        $ui_index tag remove in_sel 0.0 end
4942        $ui_workdir tag remove in_sel 0.0 end
4943
4944        if {$col == 0} {
4945                if {$current_diff_path eq $path} {
4946                        set after {reshow_diff;}
4947                } else {
4948                        set after {}
4949                }
4950                if {$w eq $ui_index} {
4951                        update_indexinfo \
4952                                "Unstaging [short_path $path] from commit" \
4953                                [list $path] \
4954                                [concat $after {set ui_status_value {Ready.}}]
4955                } elseif {$w eq $ui_workdir} {
4956                        update_index \
4957                                "Adding [short_path $path]" \
4958                                [list $path] \
4959                                [concat $after {set ui_status_value {Ready.}}]
4960                }
4961        } else {
4962                show_diff $path $w $lno
4963        }
4964}
4965
4966proc add_one_to_selection {w x y} {
4967        global file_lists last_clicked selected_paths
4968
4969        set lno [lindex [split [$w index @$x,$y] .] 0]
4970        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4971        if {$path eq {}} {
4972                set last_clicked {}
4973                return
4974        }
4975
4976        if {$last_clicked ne {}
4977                && [lindex $last_clicked 0] ne $w} {
4978                array unset selected_paths
4979                [lindex $last_clicked 0] tag remove in_sel 0.0 end
4980        }
4981
4982        set last_clicked [list $w $lno]
4983        if {[catch {set in_sel $selected_paths($path)}]} {
4984                set in_sel 0
4985        }
4986        if {$in_sel} {
4987                unset selected_paths($path)
4988                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4989        } else {
4990                set selected_paths($path) 1
4991                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4992        }
4993}
4994
4995proc add_range_to_selection {w x y} {
4996        global file_lists last_clicked selected_paths
4997
4998        if {[lindex $last_clicked 0] ne $w} {
4999                toggle_or_diff $w $x $y
5000                return
5001        }
5002
5003        set lno [lindex [split [$w index @$x,$y] .] 0]
5004        set lc [lindex $last_clicked 1]
5005        if {$lc < $lno} {
5006                set begin $lc
5007                set end $lno
5008        } else {
5009                set begin $lno
5010                set end $lc
5011        }
5012
5013        foreach path [lrange $file_lists($w) \
5014                [expr {$begin - 1}] \
5015                [expr {$end - 1}]] {
5016                set selected_paths($path) 1
5017        }
5018        $w tag add in_sel $begin.0 [expr {$end + 1}].0
5019}
5020
5021######################################################################
5022##
5023## config defaults
5024
5025set cursor_ptr arrow
5026font create font_diff -family Courier -size 10
5027font create font_ui
5028catch {
5029        label .dummy
5030        eval font configure font_ui [font actual [.dummy cget -font]]
5031        destroy .dummy
5032}
5033
5034font create font_uibold
5035font create font_diffbold
5036
5037if {[is_Windows]} {
5038        set M1B Control
5039        set M1T Ctrl
5040} elseif {[is_MacOSX]} {
5041        set M1B M1
5042        set M1T Cmd
5043} else {
5044        set M1B M1
5045        set M1T M1
5046}
5047
5048proc apply_config {} {
5049        global repo_config font_descs
5050
5051        foreach option $font_descs {
5052                set name [lindex $option 0]
5053                set font [lindex $option 1]
5054                if {[catch {
5055                        foreach {cn cv} $repo_config(gui.$name) {
5056                                font configure $font $cn $cv
5057                        }
5058                        } err]} {
5059                        error_popup "Invalid font specified in gui.$name:\n\n$err"
5060                }
5061                foreach {cn cv} [font configure $font] {
5062                        font configure ${font}bold $cn $cv
5063                }
5064                font configure ${font}bold -weight bold
5065        }
5066}
5067
5068set default_config(merge.summary) false
5069set default_config(merge.verbosity) 2
5070set default_config(user.name) {}
5071set default_config(user.email) {}
5072
5073set default_config(gui.trustmtime) false
5074set default_config(gui.diffcontext) 5
5075set default_config(gui.newbranchtemplate) {}
5076set default_config(gui.fontui) [font configure font_ui]
5077set default_config(gui.fontdiff) [font configure font_diff]
5078set font_descs {
5079        {fontui   font_ui   {Main Font}}
5080        {fontdiff font_diff {Diff/Console Font}}
5081}
5082load_config 0
5083apply_config
5084
5085######################################################################
5086##
5087## feature option selection
5088
5089if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5090        unset _junk
5091} else {
5092        set subcommand gui
5093}
5094if {$subcommand eq {gui.sh}} {
5095        set subcommand gui
5096}
5097if {$subcommand eq {gui} && [llength $argv] > 0} {
5098        set subcommand [lindex $argv 0]
5099        set argv [lrange $argv 1 end]
5100}
5101
5102enable_option multicommit
5103enable_option branch
5104enable_option transport
5105
5106switch -- $subcommand {
5107--version -
5108version -
5109browser -
5110blame {
5111        disable_option multicommit
5112        disable_option branch
5113        disable_option transport
5114}
5115citool {
5116        enable_option singlecommit
5117
5118        disable_option multicommit
5119        disable_option branch
5120        disable_option transport
5121}
5122}
5123
5124######################################################################
5125##
5126## ui construction
5127
5128set ui_comm {}
5129
5130# -- Menu Bar
5131#
5132menu .mbar -tearoff 0
5133.mbar add cascade -label Repository -menu .mbar.repository
5134.mbar add cascade -label Edit -menu .mbar.edit
5135if {[is_enabled branch]} {
5136        .mbar add cascade -label Branch -menu .mbar.branch
5137}
5138if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5139        .mbar add cascade -label Commit -menu .mbar.commit
5140}
5141if {[is_enabled transport]} {
5142        .mbar add cascade -label Merge -menu .mbar.merge
5143        .mbar add cascade -label Fetch -menu .mbar.fetch
5144        .mbar add cascade -label Push -menu .mbar.push
5145}
5146. configure -menu .mbar
5147
5148# -- Repository Menu
5149#
5150menu .mbar.repository
5151
5152.mbar.repository add command \
5153        -label {Browse Current Branch} \
5154        -command {new_browser $current_branch} \
5155        -font font_ui
5156trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5157.mbar.repository add separator
5158
5159.mbar.repository add command \
5160        -label {Visualize Current Branch} \
5161        -command {do_gitk $current_branch} \
5162        -font font_ui
5163trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5164.mbar.repository add command \
5165        -label {Visualize All Branches} \
5166        -command {do_gitk --all} \
5167        -font font_ui
5168.mbar.repository add separator
5169
5170if {[is_enabled multicommit]} {
5171        .mbar.repository add command -label {Database Statistics} \
5172                -command do_stats \
5173                -font font_ui
5174
5175        .mbar.repository add command -label {Compress Database} \
5176                -command do_gc \
5177                -font font_ui
5178
5179        .mbar.repository add command -label {Verify Database} \
5180                -command do_fsck_objects \
5181                -font font_ui
5182
5183        .mbar.repository add separator
5184
5185        if {[is_Cygwin]} {
5186                .mbar.repository add command \
5187                        -label {Create Desktop Icon} \
5188                        -command do_cygwin_shortcut \
5189                        -font font_ui
5190        } elseif {[is_Windows]} {
5191                .mbar.repository add command \
5192                        -label {Create Desktop Icon} \
5193                        -command do_windows_shortcut \
5194                        -font font_ui
5195        } elseif {[is_MacOSX]} {
5196                .mbar.repository add command \
5197                        -label {Create Desktop Icon} \
5198                        -command do_macosx_app \
5199                        -font font_ui
5200        }
5201}
5202
5203.mbar.repository add command -label Quit \
5204        -command do_quit \
5205        -accelerator $M1T-Q \
5206        -font font_ui
5207
5208# -- Edit Menu
5209#
5210menu .mbar.edit
5211.mbar.edit add command -label Undo \
5212        -command {catch {[focus] edit undo}} \
5213        -accelerator $M1T-Z \
5214        -font font_ui
5215.mbar.edit add command -label Redo \
5216        -command {catch {[focus] edit redo}} \
5217        -accelerator $M1T-Y \
5218        -font font_ui
5219.mbar.edit add separator
5220.mbar.edit add command -label Cut \
5221        -command {catch {tk_textCut [focus]}} \
5222        -accelerator $M1T-X \
5223        -font font_ui
5224.mbar.edit add command -label Copy \
5225        -command {catch {tk_textCopy [focus]}} \
5226        -accelerator $M1T-C \
5227        -font font_ui
5228.mbar.edit add command -label Paste \
5229        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5230        -accelerator $M1T-V \
5231        -font font_ui
5232.mbar.edit add command -label Delete \
5233        -command {catch {[focus] delete sel.first sel.last}} \
5234        -accelerator Del \
5235        -font font_ui
5236.mbar.edit add separator
5237.mbar.edit add command -label {Select All} \
5238        -command {catch {[focus] tag add sel 0.0 end}} \
5239        -accelerator $M1T-A \
5240        -font font_ui
5241
5242# -- Branch Menu
5243#
5244if {[is_enabled branch]} {
5245        menu .mbar.branch
5246
5247        .mbar.branch add command -label {Create...} \
5248                -command do_create_branch \
5249                -accelerator $M1T-N \
5250                -font font_ui
5251        lappend disable_on_lock [list .mbar.branch entryconf \
5252                [.mbar.branch index last] -state]
5253
5254        .mbar.branch add command -label {Delete...} \
5255                -command do_delete_branch \
5256                -font font_ui
5257        lappend disable_on_lock [list .mbar.branch entryconf \
5258                [.mbar.branch index last] -state]
5259}
5260
5261# -- Commit Menu
5262#
5263if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5264        menu .mbar.commit
5265
5266        .mbar.commit add radiobutton \
5267                -label {New Commit} \
5268                -command do_select_commit_type \
5269                -variable selected_commit_type \
5270                -value new \
5271                -font font_ui
5272        lappend disable_on_lock \
5273                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5274
5275        .mbar.commit add radiobutton \
5276                -label {Amend Last Commit} \
5277                -command do_select_commit_type \
5278                -variable selected_commit_type \
5279                -value amend \
5280                -font font_ui
5281        lappend disable_on_lock \
5282                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5283
5284        .mbar.commit add separator
5285
5286        .mbar.commit add command -label Rescan \
5287                -command do_rescan \
5288                -accelerator F5 \
5289                -font font_ui
5290        lappend disable_on_lock \
5291                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5292
5293        .mbar.commit add command -label {Add To Commit} \
5294                -command do_add_selection \
5295                -font font_ui
5296        lappend disable_on_lock \
5297                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5298
5299        .mbar.commit add command -label {Add Existing To Commit} \
5300                -command do_add_all \
5301                -accelerator $M1T-I \
5302                -font font_ui
5303        lappend disable_on_lock \
5304                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5305
5306        .mbar.commit add command -label {Unstage From Commit} \
5307                -command do_unstage_selection \
5308                -font font_ui
5309        lappend disable_on_lock \
5310                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5311
5312        .mbar.commit add command -label {Revert Changes} \
5313                -command do_revert_selection \
5314                -font font_ui
5315        lappend disable_on_lock \
5316                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5317
5318        .mbar.commit add separator
5319
5320        .mbar.commit add command -label {Sign Off} \
5321                -command do_signoff \
5322                -accelerator $M1T-S \
5323                -font font_ui
5324
5325        .mbar.commit add command -label Commit \
5326                -command do_commit \
5327                -accelerator $M1T-Return \
5328                -font font_ui
5329        lappend disable_on_lock \
5330                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5331}
5332
5333if {[is_MacOSX]} {
5334        # -- Apple Menu (Mac OS X only)
5335        #
5336        .mbar add cascade -label Apple -menu .mbar.apple
5337        menu .mbar.apple
5338
5339        .mbar.apple add command -label "About [appname]" \
5340                -command do_about \
5341                -font font_ui
5342        .mbar.apple add command -label "Options..." \
5343                -command do_options \
5344                -font font_ui
5345} else {
5346        # -- Edit Menu
5347        #
5348        .mbar.edit add separator
5349        .mbar.edit add command -label {Options...} \
5350                -command do_options \
5351                -font font_ui
5352
5353        # -- Tools Menu
5354        #
5355        if {[file exists /usr/local/miga/lib/gui-miga]
5356                && [file exists .pvcsrc]} {
5357        proc do_miga {} {
5358                global ui_status_value
5359                if {![lock_index update]} return
5360                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5361                set miga_fd [open "|$cmd" r]
5362                fconfigure $miga_fd -blocking 0
5363                fileevent $miga_fd readable [list miga_done $miga_fd]
5364                set ui_status_value {Running miga...}
5365        }
5366        proc miga_done {fd} {
5367                read $fd 512
5368                if {[eof $fd]} {
5369                        close $fd
5370                        unlock_index
5371                        rescan [list set ui_status_value {Ready.}]
5372                }
5373        }
5374        .mbar add cascade -label Tools -menu .mbar.tools
5375        menu .mbar.tools
5376        .mbar.tools add command -label "Migrate" \
5377                -command do_miga \
5378                -font font_ui
5379        lappend disable_on_lock \
5380                [list .mbar.tools entryconf [.mbar.tools index last] -state]
5381        }
5382}
5383
5384# -- Help Menu
5385#
5386.mbar add cascade -label Help -menu .mbar.help
5387menu .mbar.help
5388
5389if {![is_MacOSX]} {
5390        .mbar.help add command -label "About [appname]" \
5391                -command do_about \
5392                -font font_ui
5393}
5394
5395set browser {}
5396catch {set browser $repo_config(instaweb.browser)}
5397set doc_path [file dirname [gitexec]]
5398set doc_path [file join $doc_path Documentation index.html]
5399
5400if {[is_Cygwin]} {
5401        set doc_path [exec cygpath --mixed $doc_path]
5402}
5403
5404if {$browser eq {}} {
5405        if {[is_MacOSX]} {
5406                set browser open
5407        } elseif {[is_Cygwin]} {
5408                set program_files [file dirname [exec cygpath --windir]]
5409                set program_files [file join $program_files {Program Files}]
5410                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5411                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5412                if {[file exists $firefox]} {
5413                        set browser $firefox
5414                } elseif {[file exists $ie]} {
5415                        set browser $ie
5416                }
5417                unset program_files firefox ie
5418        }
5419}
5420
5421if {[file isfile $doc_path]} {
5422        set doc_url "file:$doc_path"
5423} else {
5424        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5425}
5426
5427if {$browser ne {}} {
5428        .mbar.help add command -label {Online Documentation} \
5429                -command [list exec $browser $doc_url &] \
5430                -font font_ui
5431}
5432unset browser doc_path doc_url
5433
5434# -- Standard bindings
5435#
5436bind .   <Destroy> do_quit
5437bind all <$M1B-Key-q> do_quit
5438bind all <$M1B-Key-Q> do_quit
5439bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5440bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5441
5442# -- Not a normal commit type invocation?  Do that instead!
5443#
5444switch -- $subcommand {
5445--version -
5446version {
5447        puts "git-gui version $appvers"
5448        exit
5449}
5450browser {
5451        if {[llength $argv] != 1} {
5452                puts stderr "usage: $argv0 browser commit"
5453                exit 1
5454        }
5455        set current_branch [lindex $argv 0]
5456        new_browser $current_branch
5457        return
5458}
5459blame {
5460        if {[llength $argv] != 2} {
5461                puts stderr "usage: $argv0 blame commit path"
5462                exit 1
5463        }
5464        set current_branch [lindex $argv 0]
5465        show_blame $current_branch [lindex $argv 1]
5466        return
5467}
5468citool -
5469gui {
5470        if {[llength $argv] != 0} {
5471                puts -nonewline stderr "usage: $argv0"
5472                if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5473                        puts -nonewline stderr " $subcommand"
5474                }
5475                puts stderr {}
5476                exit 1
5477        }
5478        # fall through to setup UI for commits
5479}
5480default {
5481        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5482        exit 1
5483}
5484}
5485
5486# -- Branch Control
5487#
5488frame .branch \
5489        -borderwidth 1 \
5490        -relief sunken
5491label .branch.l1 \
5492        -text {Current Branch:} \
5493        -anchor w \
5494        -justify left \
5495        -font font_ui
5496label .branch.cb \
5497        -textvariable current_branch \
5498        -anchor w \
5499        -justify left \
5500        -font font_ui
5501pack .branch.l1 -side left
5502pack .branch.cb -side left -fill x
5503pack .branch -side top -fill x
5504
5505if {[is_enabled branch]} {
5506        menu .mbar.merge
5507        .mbar.merge add command -label {Local Merge...} \
5508                -command do_local_merge \
5509                -font font_ui
5510        lappend disable_on_lock \
5511                [list .mbar.merge entryconf [.mbar.merge index last] -state]
5512        .mbar.merge add command -label {Abort Merge...} \
5513                -command do_reset_hard \
5514                -font font_ui
5515        lappend disable_on_lock \
5516                [list .mbar.merge entryconf [.mbar.merge index last] -state]
5517
5518
5519        menu .mbar.fetch
5520
5521        menu .mbar.push
5522        .mbar.push add command -label {Push...} \
5523                -command do_push_anywhere \
5524                -font font_ui
5525}
5526
5527# -- Main Window Layout
5528#
5529panedwindow .vpane -orient vertical
5530panedwindow .vpane.files -orient horizontal
5531.vpane add .vpane.files -sticky nsew -height 100 -width 200
5532pack .vpane -anchor n -side top -fill both -expand 1
5533
5534# -- Index File List
5535#
5536frame .vpane.files.index -height 100 -width 200
5537label .vpane.files.index.title -text {Changes To Be Committed} \
5538        -background green \
5539        -font font_ui
5540text $ui_index -background white -borderwidth 0 \
5541        -width 20 -height 10 \
5542        -wrap none \
5543        -font font_ui \
5544        -cursor $cursor_ptr \
5545        -xscrollcommand {.vpane.files.index.sx set} \
5546        -yscrollcommand {.vpane.files.index.sy set} \
5547        -state disabled
5548scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5549scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5550pack .vpane.files.index.title -side top -fill x
5551pack .vpane.files.index.sx -side bottom -fill x
5552pack .vpane.files.index.sy -side right -fill y
5553pack $ui_index -side left -fill both -expand 1
5554.vpane.files add .vpane.files.index -sticky nsew
5555
5556# -- Working Directory File List
5557#
5558frame .vpane.files.workdir -height 100 -width 200
5559label .vpane.files.workdir.title -text {Changed But Not Updated} \
5560        -background red \
5561        -font font_ui
5562text $ui_workdir -background white -borderwidth 0 \
5563        -width 20 -height 10 \
5564        -wrap none \
5565        -font font_ui \
5566        -cursor $cursor_ptr \
5567        -xscrollcommand {.vpane.files.workdir.sx set} \
5568        -yscrollcommand {.vpane.files.workdir.sy set} \
5569        -state disabled
5570scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5571scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5572pack .vpane.files.workdir.title -side top -fill x
5573pack .vpane.files.workdir.sx -side bottom -fill x
5574pack .vpane.files.workdir.sy -side right -fill y
5575pack $ui_workdir -side left -fill both -expand 1
5576.vpane.files add .vpane.files.workdir -sticky nsew
5577
5578foreach i [list $ui_index $ui_workdir] {
5579        $i tag conf in_diff -font font_uibold
5580        $i tag conf in_sel \
5581                -background [$i cget -foreground] \
5582                -foreground [$i cget -background]
5583}
5584unset i
5585
5586# -- Diff and Commit Area
5587#
5588frame .vpane.lower -height 300 -width 400
5589frame .vpane.lower.commarea
5590frame .vpane.lower.diff -relief sunken -borderwidth 1
5591pack .vpane.lower.commarea -side top -fill x
5592pack .vpane.lower.diff -side bottom -fill both -expand 1
5593.vpane add .vpane.lower -sticky nsew
5594
5595# -- Commit Area Buttons
5596#
5597frame .vpane.lower.commarea.buttons
5598label .vpane.lower.commarea.buttons.l -text {} \
5599        -anchor w \
5600        -justify left \
5601        -font font_ui
5602pack .vpane.lower.commarea.buttons.l -side top -fill x
5603pack .vpane.lower.commarea.buttons -side left -fill y
5604
5605button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5606        -command do_rescan \
5607        -font font_ui
5608pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5609lappend disable_on_lock \
5610        {.vpane.lower.commarea.buttons.rescan conf -state}
5611
5612button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5613        -command do_add_all \
5614        -font font_ui
5615pack .vpane.lower.commarea.buttons.incall -side top -fill x
5616lappend disable_on_lock \
5617        {.vpane.lower.commarea.buttons.incall conf -state}
5618
5619button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5620        -command do_signoff \
5621        -font font_ui
5622pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5623
5624button .vpane.lower.commarea.buttons.commit -text {Commit} \
5625        -command do_commit \
5626        -font font_ui
5627pack .vpane.lower.commarea.buttons.commit -side top -fill x
5628lappend disable_on_lock \
5629        {.vpane.lower.commarea.buttons.commit conf -state}
5630
5631# -- Commit Message Buffer
5632#
5633frame .vpane.lower.commarea.buffer
5634frame .vpane.lower.commarea.buffer.header
5635set ui_comm .vpane.lower.commarea.buffer.t
5636set ui_coml .vpane.lower.commarea.buffer.header.l
5637radiobutton .vpane.lower.commarea.buffer.header.new \
5638        -text {New Commit} \
5639        -command do_select_commit_type \
5640        -variable selected_commit_type \
5641        -value new \
5642        -font font_ui
5643lappend disable_on_lock \
5644        [list .vpane.lower.commarea.buffer.header.new conf -state]
5645radiobutton .vpane.lower.commarea.buffer.header.amend \
5646        -text {Amend Last Commit} \
5647        -command do_select_commit_type \
5648        -variable selected_commit_type \
5649        -value amend \
5650        -font font_ui
5651lappend disable_on_lock \
5652        [list .vpane.lower.commarea.buffer.header.amend conf -state]
5653label $ui_coml \
5654        -anchor w \
5655        -justify left \
5656        -font font_ui
5657proc trace_commit_type {varname args} {
5658        global ui_coml commit_type
5659        switch -glob -- $commit_type {
5660        initial       {set txt {Initial Commit Message:}}
5661        amend         {set txt {Amended Commit Message:}}
5662        amend-initial {set txt {Amended Initial Commit Message:}}
5663        amend-merge   {set txt {Amended Merge Commit Message:}}
5664        merge         {set txt {Merge Commit Message:}}
5665        *             {set txt {Commit Message:}}
5666        }
5667        $ui_coml conf -text $txt
5668}
5669trace add variable commit_type write trace_commit_type
5670pack $ui_coml -side left -fill x
5671pack .vpane.lower.commarea.buffer.header.amend -side right
5672pack .vpane.lower.commarea.buffer.header.new -side right
5673
5674text $ui_comm -background white -borderwidth 1 \
5675        -undo true \
5676        -maxundo 20 \
5677        -autoseparators true \
5678        -relief sunken \
5679        -width 75 -height 9 -wrap none \
5680        -font font_diff \
5681        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5682scrollbar .vpane.lower.commarea.buffer.sby \
5683        -command [list $ui_comm yview]
5684pack .vpane.lower.commarea.buffer.header -side top -fill x
5685pack .vpane.lower.commarea.buffer.sby -side right -fill y
5686pack $ui_comm -side left -fill y
5687pack .vpane.lower.commarea.buffer -side left -fill y
5688
5689# -- Commit Message Buffer Context Menu
5690#
5691set ctxm .vpane.lower.commarea.buffer.ctxm
5692menu $ctxm -tearoff 0
5693$ctxm add command \
5694        -label {Cut} \
5695        -font font_ui \
5696        -command {tk_textCut $ui_comm}
5697$ctxm add command \
5698        -label {Copy} \
5699        -font font_ui \
5700        -command {tk_textCopy $ui_comm}
5701$ctxm add command \
5702        -label {Paste} \
5703        -font font_ui \
5704        -command {tk_textPaste $ui_comm}
5705$ctxm add command \
5706        -label {Delete} \
5707        -font font_ui \
5708        -command {$ui_comm delete sel.first sel.last}
5709$ctxm add separator
5710$ctxm add command \
5711        -label {Select All} \
5712        -font font_ui \
5713        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5714$ctxm add command \
5715        -label {Copy All} \
5716        -font font_ui \
5717        -command {
5718                $ui_comm tag add sel 0.0 end
5719                tk_textCopy $ui_comm
5720                $ui_comm tag remove sel 0.0 end
5721        }
5722$ctxm add separator
5723$ctxm add command \
5724        -label {Sign Off} \
5725        -font font_ui \
5726        -command do_signoff
5727bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5728
5729# -- Diff Header
5730#
5731proc trace_current_diff_path {varname args} {
5732        global current_diff_path diff_actions file_states
5733        if {$current_diff_path eq {}} {
5734                set s {}
5735                set f {}
5736                set p {}
5737                set o disabled
5738        } else {
5739                set p $current_diff_path
5740                set s [mapdesc [lindex $file_states($p) 0] $p]
5741                set f {File:}
5742                set p [escape_path $p]
5743                set o normal
5744        }
5745
5746        .vpane.lower.diff.header.status configure -text $s
5747        .vpane.lower.diff.header.file configure -text $f
5748        .vpane.lower.diff.header.path configure -text $p
5749        foreach w $diff_actions {
5750                uplevel #0 $w $o
5751        }
5752}
5753trace add variable current_diff_path write trace_current_diff_path
5754
5755frame .vpane.lower.diff.header -background orange
5756label .vpane.lower.diff.header.status \
5757        -background orange \
5758        -width $max_status_desc \
5759        -anchor w \
5760        -justify left \
5761        -font font_ui
5762label .vpane.lower.diff.header.file \
5763        -background orange \
5764        -anchor w \
5765        -justify left \
5766        -font font_ui
5767label .vpane.lower.diff.header.path \
5768        -background orange \
5769        -anchor w \
5770        -justify left \
5771        -font font_ui
5772pack .vpane.lower.diff.header.status -side left
5773pack .vpane.lower.diff.header.file -side left
5774pack .vpane.lower.diff.header.path -fill x
5775set ctxm .vpane.lower.diff.header.ctxm
5776menu $ctxm -tearoff 0
5777$ctxm add command \
5778        -label {Copy} \
5779        -font font_ui \
5780        -command {
5781                clipboard clear
5782                clipboard append \
5783                        -format STRING \
5784                        -type STRING \
5785                        -- $current_diff_path
5786        }
5787lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5788bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5789
5790# -- Diff Body
5791#
5792frame .vpane.lower.diff.body
5793set ui_diff .vpane.lower.diff.body.t
5794text $ui_diff -background white -borderwidth 0 \
5795        -width 80 -height 15 -wrap none \
5796        -font font_diff \
5797        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5798        -yscrollcommand {.vpane.lower.diff.body.sby set} \
5799        -state disabled
5800scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5801        -command [list $ui_diff xview]
5802scrollbar .vpane.lower.diff.body.sby -orient vertical \
5803        -command [list $ui_diff yview]
5804pack .vpane.lower.diff.body.sbx -side bottom -fill x
5805pack .vpane.lower.diff.body.sby -side right -fill y
5806pack $ui_diff -side left -fill both -expand 1
5807pack .vpane.lower.diff.header -side top -fill x
5808pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5809
5810$ui_diff tag conf d_cr -elide true
5811$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5812$ui_diff tag conf d_+ -foreground {#00a000}
5813$ui_diff tag conf d_- -foreground red
5814
5815$ui_diff tag conf d_++ -foreground {#00a000}
5816$ui_diff tag conf d_-- -foreground red
5817$ui_diff tag conf d_+s \
5818        -foreground {#00a000} \
5819        -background {#e2effa}
5820$ui_diff tag conf d_-s \
5821        -foreground red \
5822        -background {#e2effa}
5823$ui_diff tag conf d_s+ \
5824        -foreground {#00a000} \
5825        -background ivory1
5826$ui_diff tag conf d_s- \
5827        -foreground red \
5828        -background ivory1
5829
5830$ui_diff tag conf d<<<<<<< \
5831        -foreground orange \
5832        -font font_diffbold
5833$ui_diff tag conf d======= \
5834        -foreground orange \
5835        -font font_diffbold
5836$ui_diff tag conf d>>>>>>> \
5837        -foreground orange \
5838        -font font_diffbold
5839
5840$ui_diff tag raise sel
5841
5842# -- Diff Body Context Menu
5843#
5844set ctxm .vpane.lower.diff.body.ctxm
5845menu $ctxm -tearoff 0
5846$ctxm add command \
5847        -label {Refresh} \
5848        -font font_ui \
5849        -command reshow_diff
5850lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5851$ctxm add command \
5852        -label {Copy} \
5853        -font font_ui \
5854        -command {tk_textCopy $ui_diff}
5855lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5856$ctxm add command \
5857        -label {Select All} \
5858        -font font_ui \
5859        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5860lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5861$ctxm add command \
5862        -label {Copy All} \
5863        -font font_ui \
5864        -command {
5865                $ui_diff tag add sel 0.0 end
5866                tk_textCopy $ui_diff
5867                $ui_diff tag remove sel 0.0 end
5868        }
5869lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5870$ctxm add separator
5871$ctxm add command \
5872        -label {Apply/Reverse Hunk} \
5873        -font font_ui \
5874        -command {apply_hunk $cursorX $cursorY}
5875set ui_diff_applyhunk [$ctxm index last]
5876lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5877$ctxm add separator
5878$ctxm add command \
5879        -label {Decrease Font Size} \
5880        -font font_ui \
5881        -command {incr_font_size font_diff -1}
5882lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5883$ctxm add command \
5884        -label {Increase Font Size} \
5885        -font font_ui \
5886        -command {incr_font_size font_diff 1}
5887lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5888$ctxm add separator
5889$ctxm add command \
5890        -label {Show Less Context} \
5891        -font font_ui \
5892        -command {if {$repo_config(gui.diffcontext) >= 2} {
5893                incr repo_config(gui.diffcontext) -1
5894                reshow_diff
5895        }}
5896lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5897$ctxm add command \
5898        -label {Show More Context} \
5899        -font font_ui \
5900        -command {
5901                incr repo_config(gui.diffcontext)
5902                reshow_diff
5903        }
5904lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5905$ctxm add separator
5906$ctxm add command -label {Options...} \
5907        -font font_ui \
5908        -command do_options
5909bind_button3 $ui_diff "
5910        set cursorX %x
5911        set cursorY %y
5912        if {\$ui_index eq \$current_diff_side} {
5913                $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5914        } else {
5915                $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5916        }
5917        tk_popup $ctxm %X %Y
5918"
5919unset ui_diff_applyhunk
5920
5921# -- Status Bar
5922#
5923label .status -textvariable ui_status_value \
5924        -anchor w \
5925        -justify left \
5926        -borderwidth 1 \
5927        -relief sunken \
5928        -font font_ui
5929pack .status -anchor w -side bottom -fill x
5930
5931# -- Load geometry
5932#
5933catch {
5934set gm $repo_config(gui.geometry)
5935wm geometry . [lindex $gm 0]
5936.vpane sash place 0 \
5937        [lindex [.vpane sash coord 0] 0] \
5938        [lindex $gm 1]
5939.vpane.files sash place 0 \
5940        [lindex $gm 2] \
5941        [lindex [.vpane.files sash coord 0] 1]
5942unset gm
5943}
5944
5945# -- Key Bindings
5946#
5947bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5948bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5949bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5950bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5951bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5952bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5953bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5954bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5955bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5956bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5957bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5958
5959bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5960bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5961bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5962bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5963bind $ui_diff <$M1B-Key-v> {break}
5964bind $ui_diff <$M1B-Key-V> {break}
5965bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5966bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5967bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5968bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5969bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5970bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5971bind $ui_diff <Button-1>   {focus %W}
5972
5973if {[is_enabled branch]} {
5974        bind . <$M1B-Key-n> do_create_branch
5975        bind . <$M1B-Key-N> do_create_branch
5976}
5977
5978bind all <Key-F5> do_rescan
5979bind all <$M1B-Key-r> do_rescan
5980bind all <$M1B-Key-R> do_rescan
5981bind .   <$M1B-Key-s> do_signoff
5982bind .   <$M1B-Key-S> do_signoff
5983bind .   <$M1B-Key-i> do_add_all
5984bind .   <$M1B-Key-I> do_add_all
5985bind .   <$M1B-Key-Return> do_commit
5986foreach i [list $ui_index $ui_workdir] {
5987        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5988        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5989        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5990}
5991unset i
5992
5993set file_lists($ui_index) [list]
5994set file_lists($ui_workdir) [list]
5995
5996wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5997focus -force $ui_comm
5998
5999# -- Warn the user about environmental problems.  Cygwin's Tcl
6000#    does *not* pass its env array onto any processes it spawns.
6001#    This means that git processes get none of our environment.
6002#
6003if {[is_Cygwin]} {
6004        set ignored_env 0
6005        set suggest_user {}
6006        set msg "Possible environment issues exist.
6007
6008The following environment variables are probably
6009going to be ignored by any Git subprocess run
6010by [appname]:
6011
6012"
6013        foreach name [array names env] {
6014                switch -regexp -- $name {
6015                {^GIT_INDEX_FILE$} -
6016                {^GIT_OBJECT_DIRECTORY$} -
6017                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6018                {^GIT_DIFF_OPTS$} -
6019                {^GIT_EXTERNAL_DIFF$} -
6020                {^GIT_PAGER$} -
6021                {^GIT_TRACE$} -
6022                {^GIT_CONFIG$} -
6023                {^GIT_CONFIG_LOCAL$} -
6024                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6025                        append msg " - $name\n"
6026                        incr ignored_env
6027                }
6028                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6029                        append msg " - $name\n"
6030                        incr ignored_env
6031                        set suggest_user $name
6032                }
6033                }
6034        }
6035        if {$ignored_env > 0} {
6036                append msg "
6037This is due to a known issue with the
6038Tcl binary distributed by Cygwin."
6039
6040                if {$suggest_user ne {}} {
6041                        append msg "
6042
6043A good replacement for $suggest_user
6044is placing values for the user.name and
6045user.email settings into your personal
6046~/.gitconfig file.
6047"
6048                }
6049                warn_popup $msg
6050        }
6051        unset ignored_env msg suggest_user name
6052}
6053
6054# -- Only initialize complex UI if we are going to stay running.
6055#
6056if {[is_enabled transport]} {
6057        load_all_remotes
6058        load_all_heads
6059
6060        populate_branch_menu
6061        populate_fetch_menu
6062        populate_push_menu
6063}
6064
6065# -- Only suggest a gc run if we are going to stay running.
6066#
6067if {[is_enabled multicommit]} {
6068        set object_limit 2000
6069        if {[is_Windows]} {set object_limit 200}
6070        regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6071        if {$objects_current >= $object_limit} {
6072                if {[ask_popup \
6073                        "This repository currently has $objects_current loose objects.
6074
6075To maintain optimal performance it is strongly
6076recommended that you compress the database
6077when more than $object_limit loose objects exist.
6078
6079Compress the database now?"] eq yes} {
6080                        do_gc
6081                }
6082        }
6083        unset object_limit _junk objects_current
6084}
6085
6086lock_index begin-read
6087after 1 do_rescan