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