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