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