dd8a408c644ad190cf69aa60f8d62a6a2ed625be
   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
2911in an octopus merge.  This exceeds Git's
2912internal limit of 15 branches per merge.
2913
2914Please select fewer branches.  To merge more
2915than 15 branches, merge the branches in batches.
2916"
2917                return
2918        }
2919
2920        set msg "Merging $current_branch, [join $names {, }]"
2921        set ui_status_value "$msg..."
2922        set cons [new_console "Merge" $msg]
2923        console_exec $cons $cmd [list finish_merge $revcnt]
2924        bind $w <Destroy> {}
2925        destroy $w
2926}
2927
2928proc finish_merge {revcnt w ok} {
2929        console_done $w $ok
2930        if {$ok} {
2931                set msg {Merge completed successfully.}
2932        } else {
2933                if {$revcnt != 1} {
2934                        info_popup "Octopus merge failed.
2935
2936Your merge of $revcnt branches has failed.
2937
2938There are file-level conflicts between the branches which must be resolved manually.
2939
2940The working directory will now be reset.
2941
2942You can attempt this merge again by merging only one branch at a time." $w
2943
2944                        set fd [open "| git read-tree --reset -u HEAD" r]
2945                        fconfigure $fd -blocking 0 -translation binary
2946                        fileevent $fd readable [list reset_hard_wait $fd]
2947                        set ui_status_value {Aborting... please wait...}
2948                        return
2949                }
2950
2951                set msg {Merge failed.  Conflict resolution is required.}
2952        }
2953        unlock_index
2954        rescan [list set ui_status_value $msg]
2955}
2956
2957proc do_local_merge {} {
2958        global current_branch
2959
2960        if {![can_merge]} return
2961
2962        set w .merge_setup
2963        toplevel $w
2964        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2965
2966        label $w.header \
2967                -text "Merge Into $current_branch" \
2968                -font font_uibold
2969        pack $w.header -side top -fill x
2970
2971        frame $w.buttons
2972        button $w.buttons.visualize -text Visualize \
2973                -font font_ui \
2974                -command [list visualize_local_merge $w]
2975        pack $w.buttons.visualize -side left
2976        button $w.buttons.create -text Merge \
2977                -font font_ui \
2978                -command [list start_local_merge_action $w]
2979        pack $w.buttons.create -side right
2980        button $w.buttons.cancel -text {Cancel} \
2981                -font font_ui \
2982                -command [list destroy $w]
2983        pack $w.buttons.cancel -side right -padx 5
2984        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2985
2986        labelframe $w.source \
2987                -text {Source Branches} \
2988                -font font_ui
2989        listbox $w.source.l \
2990                -height 10 \
2991                -width 70 \
2992                -selectmode extended \
2993                -yscrollcommand [list $w.source.sby set] \
2994                -font font_ui
2995        scrollbar $w.source.sby -command [list $w.source.l yview]
2996        pack $w.source.sby -side right -fill y
2997        pack $w.source.l -side left -fill both -expand 1
2998        pack $w.source -fill both -expand 1 -pady 5 -padx 5
2999
3000        set cmd [list git for-each-ref]
3001        lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
3002        lappend cmd refs/heads
3003        lappend cmd refs/remotes
3004        lappend cmd refs/tags
3005        set fr_fd [open "| $cmd" r]
3006        fconfigure $fr_fd -translation binary
3007        while {[gets $fr_fd line] > 0} {
3008                set line [split $line { }]
3009                set sha1([lindex $line 0]) [lindex $line 2]
3010                set sha1([lindex $line 1]) [lindex $line 2]
3011        }
3012        close $fr_fd
3013
3014        set to_show {}
3015        set fr_fd [open "| git rev-list --all --not HEAD"]
3016        while {[gets $fr_fd line] > 0} {
3017                if {[catch {set ref $sha1($line)}]} continue
3018                regsub ^refs/(heads|remotes|tags)/ $ref {} ref
3019                lappend to_show $ref
3020        }
3021        close $fr_fd
3022
3023        foreach ref [lsort -unique $to_show] {
3024                $w.source.l insert end $ref
3025        }
3026
3027        bind $w <Visibility> "grab $w"
3028        bind $w <Key-Escape> "unlock_index;destroy $w"
3029        bind $w <Destroy> unlock_index
3030        wm title $w "[appname] ([reponame]): Merge"
3031        tkwait window $w
3032}
3033
3034proc do_reset_hard {} {
3035        global HEAD commit_type file_states
3036
3037        if {[string match amend* $commit_type]} {
3038                info_popup {Cannot abort while amending.
3039
3040You must finish amending this commit.
3041}
3042                return
3043        }
3044
3045        if {![lock_index abort]} return
3046
3047        if {[string match *merge* $commit_type]} {
3048                set op merge
3049        } else {
3050                set op commit
3051        }
3052
3053        if {[ask_popup "Abort $op?
3054
3055Aborting the current $op will cause *ALL* uncommitted changes to be lost.
3056
3057Continue with aborting the current $op?"] eq {yes}} {
3058                set fd [open "| git read-tree --reset -u HEAD" r]
3059                fconfigure $fd -blocking 0 -translation binary
3060                fileevent $fd readable [list reset_hard_wait $fd]
3061                set ui_status_value {Aborting... please wait...}
3062        } else {
3063                unlock_index
3064        }
3065}
3066
3067proc reset_hard_wait {fd} {
3068        global ui_comm
3069
3070        read $fd
3071        if {[eof $fd]} {
3072                close $fd
3073                unlock_index
3074
3075                $ui_comm delete 0.0 end
3076                $ui_comm edit modified false
3077
3078                catch {file delete [gitdir MERGE_HEAD]}
3079                catch {file delete [gitdir rr-cache MERGE_RR]}
3080                catch {file delete [gitdir SQUASH_MSG]}
3081                catch {file delete [gitdir MERGE_MSG]}
3082                catch {file delete [gitdir GITGUI_MSG]}
3083
3084                rescan {set ui_status_value {Abort completed.  Ready.}}
3085        }
3086}
3087
3088######################################################################
3089##
3090## browser
3091
3092set next_browser_id 0
3093
3094proc new_browser {commit} {
3095        global next_browser_id cursor_ptr M1B
3096        global browser_commit browser_status browser_stack browser_path browser_busy
3097
3098        if {[winfo ismapped .]} {
3099                set w .browser[incr next_browser_id]
3100                set tl $w
3101                toplevel $w
3102        } else {
3103                set w {}
3104                set tl .
3105        }
3106        set w_list $w.list.l
3107        set browser_commit($w_list) $commit
3108        set browser_status($w_list) {Starting...}
3109        set browser_stack($w_list) {}
3110        set browser_path($w_list) $browser_commit($w_list):
3111        set browser_busy($w_list) 1
3112
3113        label $w.path -textvariable browser_path($w_list) \
3114                -anchor w \
3115                -justify left \
3116                -borderwidth 1 \
3117                -relief sunken \
3118                -font font_uibold
3119        pack $w.path -anchor w -side top -fill x
3120
3121        frame $w.list
3122        text $w_list -background white -borderwidth 0 \
3123                -cursor $cursor_ptr \
3124                -state disabled \
3125                -wrap none \
3126                -height 20 \
3127                -width 70 \
3128                -xscrollcommand [list $w.list.sbx set] \
3129                -yscrollcommand [list $w.list.sby set] \
3130                -font font_ui
3131        $w_list tag conf in_sel \
3132                -background [$w_list cget -foreground] \
3133                -foreground [$w_list cget -background]
3134        scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3135        scrollbar $w.list.sby -orient v -command [list $w_list yview]
3136        pack $w.list.sbx -side bottom -fill x
3137        pack $w.list.sby -side right -fill y
3138        pack $w_list -side left -fill both -expand 1
3139        pack $w.list -side top -fill both -expand 1
3140
3141        label $w.status -textvariable browser_status($w_list) \
3142                -anchor w \
3143                -justify left \
3144                -borderwidth 1 \
3145                -relief sunken \
3146                -font font_ui
3147        pack $w.status -anchor w -side bottom -fill x
3148
3149        bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3150        bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3151        bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3152        bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3153        bind $w_list <Up>              "browser_move -1 $w_list;break"
3154        bind $w_list <Down>            "browser_move 1 $w_list;break"
3155        bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3156        bind $w_list <Return>          "browser_enter $w_list;break"
3157        bind $w_list <Prior>           "browser_page -1 $w_list;break"
3158        bind $w_list <Next>            "browser_page 1 $w_list;break"
3159        bind $w_list <Left>            break
3160        bind $w_list <Right>           break
3161
3162        bind $tl <Visibility> "focus $w"
3163        bind $tl <Destroy> "
3164                array unset browser_buffer $w_list
3165                array unset browser_files $w_list
3166                array unset browser_status $w_list
3167                array unset browser_stack $w_list
3168                array unset browser_path $w_list
3169                array unset browser_commit $w_list
3170                array unset browser_busy $w_list
3171        "
3172        wm title $tl "[appname] ([reponame]): File Browser"
3173        ls_tree $w_list $browser_commit($w_list) {}
3174}
3175
3176proc browser_move {dir w} {
3177        global browser_files browser_busy
3178
3179        if {$browser_busy($w)} return
3180        set lno [lindex [split [$w index in_sel.first] .] 0]
3181        incr lno $dir
3182        if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3183                $w tag remove in_sel 0.0 end
3184                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3185                $w see $lno.0
3186        }
3187}
3188
3189proc browser_page {dir w} {
3190        global browser_files browser_busy
3191
3192        if {$browser_busy($w)} return
3193        $w yview scroll $dir pages
3194        set lno [expr {int(
3195                  [lindex [$w yview] 0]
3196                * [llength $browser_files($w)]
3197                + 1)}]
3198        if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3199                $w tag remove in_sel 0.0 end
3200                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3201                $w see $lno.0
3202        }
3203}
3204
3205proc browser_parent {w} {
3206        global browser_files browser_status browser_path
3207        global browser_stack browser_busy
3208
3209        if {$browser_busy($w)} return
3210        set info [lindex $browser_files($w) 0]
3211        if {[lindex $info 0] eq {parent}} {
3212                set parent [lindex $browser_stack($w) end-1]
3213                set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3214                if {$browser_stack($w) eq {}} {
3215                        regsub {:.*$} $browser_path($w) {:} browser_path($w)
3216                } else {
3217                        regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3218                }
3219                set browser_status($w) "Loading $browser_path($w)..."
3220                ls_tree $w [lindex $parent 0] [lindex $parent 1]
3221        }
3222}
3223
3224proc browser_enter {w} {
3225        global browser_files browser_status browser_path
3226        global browser_commit browser_stack browser_busy
3227
3228        if {$browser_busy($w)} return
3229        set lno [lindex [split [$w index in_sel.first] .] 0]
3230        set info [lindex $browser_files($w) [expr {$lno - 1}]]
3231        if {$info ne {}} {
3232                switch -- [lindex $info 0] {
3233                parent {
3234                        browser_parent $w
3235                }
3236                tree {
3237                        set name [lindex $info 2]
3238                        set escn [escape_path $name]
3239                        set browser_status($w) "Loading $escn..."
3240                        append browser_path($w) $escn
3241                        ls_tree $w [lindex $info 1] $name
3242                }
3243                blob {
3244                        set name [lindex $info 2]
3245                        set p {}
3246                        foreach n $browser_stack($w) {
3247                                append p [lindex $n 1]
3248                        }
3249                        append p $name
3250                        show_blame $browser_commit($w) $p
3251                }
3252                }
3253        }
3254}
3255
3256proc browser_click {was_double_click w pos} {
3257        global browser_files browser_busy
3258
3259        if {$browser_busy($w)} return
3260        set lno [lindex [split [$w index $pos] .] 0]
3261        focus $w
3262
3263        if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3264                $w tag remove in_sel 0.0 end
3265                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3266                if {$was_double_click} {
3267                        browser_enter $w
3268                }
3269        }
3270}
3271
3272proc ls_tree {w tree_id name} {
3273        global browser_buffer browser_files browser_stack browser_busy
3274
3275        set browser_buffer($w) {}
3276        set browser_files($w) {}
3277        set browser_busy($w) 1
3278
3279        $w conf -state normal
3280        $w tag remove in_sel 0.0 end
3281        $w delete 0.0 end
3282        if {$browser_stack($w) ne {}} {
3283                $w image create end \
3284                        -align center -padx 5 -pady 1 \
3285                        -name icon0 \
3286                        -image file_uplevel
3287                $w insert end {[Up To Parent]}
3288                lappend browser_files($w) parent
3289        }
3290        lappend browser_stack($w) [list $tree_id $name]
3291        $w conf -state disabled
3292
3293        set cmd [list git ls-tree -z $tree_id]
3294        set fd [open "| $cmd" r]
3295        fconfigure $fd -blocking 0 -translation binary -encoding binary
3296        fileevent $fd readable [list read_ls_tree $fd $w]
3297}
3298
3299proc read_ls_tree {fd w} {
3300        global browser_buffer browser_files browser_status browser_busy
3301
3302        if {![winfo exists $w]} {
3303                catch {close $fd}
3304                return
3305        }
3306
3307        append browser_buffer($w) [read $fd]
3308        set pck [split $browser_buffer($w) "\0"]
3309        set browser_buffer($w) [lindex $pck end]
3310
3311        set n [llength $browser_files($w)]
3312        $w conf -state normal
3313        foreach p [lrange $pck 0 end-1] {
3314                set info [split $p "\t"]
3315                set path [lindex $info 1]
3316                set info [split [lindex $info 0] { }]
3317                set type [lindex $info 1]
3318                set object [lindex $info 2]
3319
3320                switch -- $type {
3321                blob {
3322                        set image file_mod
3323                }
3324                tree {
3325                        set image file_dir
3326                        append path /
3327                }
3328                default {
3329                        set image file_question
3330                }
3331                }
3332
3333                if {$n > 0} {$w insert end "\n"}
3334                $w image create end \
3335                        -align center -padx 5 -pady 1 \
3336                        -name icon[incr n] \
3337                        -image $image
3338                $w insert end [escape_path $path]
3339                lappend browser_files($w) [list $type $object $path]
3340        }
3341        $w conf -state disabled
3342
3343        if {[eof $fd]} {
3344                close $fd
3345                set browser_status($w) Ready.
3346                set browser_busy($w) 0
3347                array unset browser_buffer $w
3348                if {$n > 0} {
3349                        $w tag add in_sel 1.0 2.0
3350                        focus -force $w
3351                }
3352        }
3353}
3354
3355proc show_blame {commit path} {
3356        global next_browser_id blame_status blame_data
3357
3358        if {[winfo ismapped .]} {
3359                set w .browser[incr next_browser_id]
3360                set tl $w
3361                toplevel $w
3362        } else {
3363                set w {}
3364                set tl .
3365        }
3366        set blame_status($w) {Loading current file content...}
3367
3368        label $w.path -text "$commit:$path" \
3369                -anchor w \
3370                -justify left \
3371                -borderwidth 1 \
3372                -relief sunken \
3373                -font font_uibold
3374        pack $w.path -side top -fill x
3375
3376        frame $w.out
3377        text $w.out.loaded_t \
3378                -background white -borderwidth 0 \
3379                -state disabled \
3380                -wrap none \
3381                -height 40 \
3382                -width 1 \
3383                -font font_diff
3384        $w.out.loaded_t tag conf annotated -background grey
3385
3386        text $w.out.linenumber_t \
3387                -background white -borderwidth 0 \
3388                -state disabled \
3389                -wrap none \
3390                -height 40 \
3391                -width 5 \
3392                -font font_diff
3393        $w.out.linenumber_t tag conf linenumber -justify right
3394
3395        text $w.out.file_t \
3396                -background white -borderwidth 0 \
3397                -state disabled \
3398                -wrap none \
3399                -height 40 \
3400                -width 80 \
3401                -xscrollcommand [list $w.out.sbx set] \
3402                -font font_diff
3403
3404        scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3405        scrollbar $w.out.sby -orient v \
3406                -command [list scrollbar2many [list \
3407                $w.out.loaded_t \
3408                $w.out.linenumber_t \
3409                $w.out.file_t \
3410                ] yview]
3411        grid \
3412                $w.out.linenumber_t \
3413                $w.out.loaded_t \
3414                $w.out.file_t \
3415                $w.out.sby \
3416                -sticky nsew
3417        grid conf $w.out.sbx -column 2 -sticky we
3418        grid columnconfigure $w.out 2 -weight 1
3419        grid rowconfigure $w.out 0 -weight 1
3420        pack $w.out -fill both -expand 1
3421
3422        label $w.status -textvariable blame_status($w) \
3423                -anchor w \
3424                -justify left \
3425                -borderwidth 1 \
3426                -relief sunken \
3427                -font font_ui
3428        pack $w.status -side bottom -fill x
3429
3430        frame $w.cm
3431        text $w.cm.t \
3432                -background white -borderwidth 0 \
3433                -state disabled \
3434                -wrap none \
3435                -height 10 \
3436                -width 80 \
3437                -xscrollcommand [list $w.cm.sbx set] \
3438                -yscrollcommand [list $w.cm.sby set] \
3439                -font font_diff
3440        scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3441        scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3442        pack $w.cm.sby -side right -fill y
3443        pack $w.cm.sbx -side bottom -fill x
3444        pack $w.cm.t -expand 1 -fill both
3445        pack $w.cm -side bottom -fill x
3446
3447        menu $w.ctxm -tearoff 0
3448        $w.ctxm add command -label "Copy Commit" \
3449                -font font_ui \
3450                -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3451
3452        foreach i [list \
3453                $w.out.loaded_t \
3454                $w.out.linenumber_t \
3455                $w.out.file_t] {
3456                $i tag conf in_sel \
3457                        -background [$i cget -foreground] \
3458                        -foreground [$i cget -background]
3459                $i conf -yscrollcommand \
3460                        [list many2scrollbar [list \
3461                        $w.out.loaded_t \
3462                        $w.out.linenumber_t \
3463                        $w.out.file_t \
3464                        ] yview $w.out.sby]
3465                bind $i <Button-1> "
3466                        blame_click {$w} \\
3467                                $w.cm.t \\
3468                                $w.out.linenumber_t \\
3469                                $w.out.file_t \\
3470                                $i @%x,%y
3471                        focus $i
3472                "
3473                bind_button3 $i "
3474                        set cursorX %x
3475                        set cursorY %y
3476                        set cursorW %W
3477                        tk_popup $w.ctxm %X %Y
3478                "
3479        }
3480
3481        bind $w.cm.t <Button-1> "focus $w.cm.t"
3482        bind $tl <Visibility> "focus $tl"
3483        bind $tl <Destroy> "
3484                array unset blame_status {$w}
3485                array unset blame_data $w,*
3486        "
3487        wm title $tl "[appname] ([reponame]): File Viewer"
3488
3489        set blame_data($w,commit_count) 0
3490        set blame_data($w,commit_list) {}
3491        set blame_data($w,total_lines) 0
3492        set blame_data($w,blame_lines) 0
3493        set blame_data($w,highlight_commit) {}
3494        set blame_data($w,highlight_line) -1
3495
3496        set cmd [list git cat-file blob "$commit:$path"]
3497        set fd [open "| $cmd" r]
3498        fconfigure $fd -blocking 0 -translation lf -encoding binary
3499        fileevent $fd readable [list read_blame_catfile \
3500                $fd $w $commit $path \
3501                $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3502}
3503
3504proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3505        global blame_status blame_data
3506
3507        if {![winfo exists $w_file]} {
3508                catch {close $fd}
3509                return
3510        }
3511
3512        set n $blame_data($w,total_lines)
3513        $w_load conf -state normal
3514        $w_line conf -state normal
3515        $w_file conf -state normal
3516        while {[gets $fd line] >= 0} {
3517                regsub "\r\$" $line {} line
3518                incr n
3519                $w_load insert end "\n"
3520                $w_line insert end "$n\n" linenumber
3521                $w_file insert end "$line\n"
3522        }
3523        $w_load conf -state disabled
3524        $w_line conf -state disabled
3525        $w_file conf -state disabled
3526        set blame_data($w,total_lines) $n
3527
3528        if {[eof $fd]} {
3529                close $fd
3530                blame_incremental_status $w
3531                set cmd [list git blame -M -C --incremental]
3532                lappend cmd $commit -- $path
3533                set fd [open "| $cmd" r]
3534                fconfigure $fd -blocking 0 -translation lf -encoding binary
3535                fileevent $fd readable [list read_blame_incremental $fd $w \
3536                        $w_load $w_cmit $w_line $w_file]
3537        }
3538}
3539
3540proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3541        global blame_status blame_data
3542
3543        if {![winfo exists $w_file]} {
3544                catch {close $fd}
3545                return
3546        }
3547
3548        while {[gets $fd line] >= 0} {
3549                if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3550                        cmit original_line final_line line_count]} {
3551                        set blame_data($w,commit) $cmit
3552                        set blame_data($w,original_line) $original_line
3553                        set blame_data($w,final_line) $final_line
3554                        set blame_data($w,line_count) $line_count
3555
3556                        if {[catch {set g $blame_data($w,$cmit,order)}]} {
3557                                $w_line tag conf g$cmit
3558                                $w_file tag conf g$cmit
3559                                $w_line tag raise in_sel
3560                                $w_file tag raise in_sel
3561                                $w_file tag raise sel
3562                                set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3563                                incr blame_data($w,commit_count)
3564                                lappend blame_data($w,commit_list) $cmit
3565                        }
3566                } elseif {[string match {filename *} $line]} {
3567                        set file [string range $line 9 end]
3568                        set n $blame_data($w,line_count)
3569                        set lno $blame_data($w,final_line)
3570                        set cmit $blame_data($w,commit)
3571
3572                        while {$n > 0} {
3573                                if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3574                                        $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3575                                } else {
3576                                        $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3577                                        $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3578                                }
3579
3580                                set blame_data($w,line$lno,commit) $cmit
3581                                set blame_data($w,line$lno,file) $file
3582                                $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3583                                $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3584
3585                                if {$blame_data($w,highlight_line) == -1} {
3586                                        if {[lindex [$w_file yview] 0] == 0} {
3587                                                $w_file see $lno.0
3588                                                blame_showcommit $w $w_cmit $w_line $w_file $lno
3589                                        }
3590                                } elseif {$blame_data($w,highlight_line) == $lno} {
3591                                        blame_showcommit $w $w_cmit $w_line $w_file $lno
3592                                }
3593
3594                                incr n -1
3595                                incr lno
3596                                incr blame_data($w,blame_lines)
3597                        }
3598
3599                        set hc $blame_data($w,highlight_commit)
3600                        if {$hc ne {}
3601                                && [expr {$blame_data($w,$hc,order) + 1}]
3602                                        == $blame_data($w,$cmit,order)} {
3603                                blame_showcommit $w $w_cmit $w_line $w_file \
3604                                        $blame_data($w,highlight_line)
3605                        }
3606                } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3607                        set blame_data($w,$blame_data($w,commit),$header) $data
3608                }
3609        }
3610
3611        if {[eof $fd]} {
3612                close $fd
3613                set blame_status($w) {Annotation complete.}
3614        } else {
3615                blame_incremental_status $w
3616        }
3617}
3618
3619proc blame_incremental_status {w} {
3620        global blame_status blame_data
3621
3622        set have  $blame_data($w,blame_lines)
3623        set total $blame_data($w,total_lines)
3624        set pdone 0
3625        if {$total} {set pdone [expr {100 * $have / $total}]}
3626
3627        set blame_status($w) [format \
3628                "Loading annotations... %i of %i lines annotated (%2i%%)" \
3629                $have $total $pdone]
3630}
3631
3632proc blame_click {w w_cmit w_line w_file cur_w pos} {
3633        set lno [lindex [split [$cur_w index $pos] .] 0]
3634        if {$lno eq {}} return
3635
3636        $w_line tag remove in_sel 0.0 end
3637        $w_file tag remove in_sel 0.0 end
3638        $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3639        $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3640
3641        blame_showcommit $w $w_cmit $w_line $w_file $lno
3642}
3643
3644set blame_colors {
3645        #ff4040
3646        #ff40ff
3647        #4040ff
3648}
3649
3650proc blame_showcommit {w w_cmit w_line w_file lno} {
3651        global blame_colors blame_data repo_config
3652
3653        set cmit $blame_data($w,highlight_commit)
3654        if {$cmit ne {}} {
3655                set idx $blame_data($w,$cmit,order)
3656                set i 0
3657                foreach c $blame_colors {
3658                        set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3659                        $w_line tag conf g$h -background white
3660                        $w_file tag conf g$h -background white
3661                        incr i
3662                }
3663        }
3664
3665        $w_cmit conf -state normal
3666        $w_cmit delete 0.0 end
3667        if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3668                set cmit {}
3669                $w_cmit insert end "Loading annotation..."
3670        } else {
3671                set idx $blame_data($w,$cmit,order)
3672                set i 0
3673                foreach c $blame_colors {
3674                        set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3675                        $w_line tag conf g$h -background $c
3676                        $w_file tag conf g$h -background $c
3677                        incr i
3678                }
3679
3680                set author_name {}
3681                set author_email {}
3682                set author_time {}
3683                catch {set author_name $blame_data($w,$cmit,author)}
3684                catch {set author_email $blame_data($w,$cmit,author-mail)}
3685                catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3686
3687                set committer_name {}
3688                set committer_email {}
3689                set committer_time {}
3690                catch {set committer_name $blame_data($w,$cmit,committer)}
3691                catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3692                catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3693
3694                if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3695                        set msg {}
3696                        catch {
3697                                set fd [open "| git cat-file commit $cmit" r]
3698                                fconfigure $fd -encoding binary -translation lf
3699                                if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3700                                        set enc utf-8
3701                                }
3702                                while {[gets $fd line] > 0} {
3703                                        if {[string match {encoding *} $line]} {
3704                                                set enc [string tolower [string range $line 9 end]]
3705                                        }
3706                                }
3707                                set msg [encoding convertfrom $enc [read $fd]]
3708                                set msg [string trim $msg]
3709                                close $fd
3710
3711                                set author_name [encoding convertfrom $enc $author_name]
3712                                set committer_name [encoding convertfrom $enc $committer_name]
3713
3714                                set blame_data($w,$cmit,author) $author_name
3715                                set blame_data($w,$cmit,committer) $committer_name
3716                        }
3717                        set blame_data($w,$cmit,message) $msg
3718                }
3719
3720                $w_cmit insert end "commit $cmit\n"
3721                $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3722                $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3723                $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3724                $w_cmit insert end "\n"
3725                $w_cmit insert end $msg
3726        }
3727        $w_cmit conf -state disabled
3728
3729        set blame_data($w,highlight_line) $lno
3730        set blame_data($w,highlight_commit) $cmit
3731}
3732
3733proc blame_copycommit {w i pos} {
3734        global blame_data
3735        set lno [lindex [split [$i index $pos] .] 0]
3736        if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3737                clipboard clear
3738                clipboard append \
3739                        -format STRING \
3740                        -type STRING \
3741                        -- $commit
3742        }
3743}
3744
3745######################################################################
3746##
3747## icons
3748
3749set filemask {
3750#define mask_width 14
3751#define mask_height 15
3752static unsigned char mask_bits[] = {
3753   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3754   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3755   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3756}
3757
3758image create bitmap file_plain -background white -foreground black -data {
3759#define plain_width 14
3760#define plain_height 15
3761static unsigned char plain_bits[] = {
3762   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3763   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3764   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3765} -maskdata $filemask
3766
3767image create bitmap file_mod -background white -foreground blue -data {
3768#define mod_width 14
3769#define mod_height 15
3770static unsigned char mod_bits[] = {
3771   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3772   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3773   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3774} -maskdata $filemask
3775
3776image create bitmap file_fulltick -background white -foreground "#007000" -data {
3777#define file_fulltick_width 14
3778#define file_fulltick_height 15
3779static unsigned char file_fulltick_bits[] = {
3780   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3781   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3782   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3783} -maskdata $filemask
3784
3785image create bitmap file_parttick -background white -foreground "#005050" -data {
3786#define parttick_width 14
3787#define parttick_height 15
3788static unsigned char parttick_bits[] = {
3789   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3790   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3791   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3792} -maskdata $filemask
3793
3794image create bitmap file_question -background white -foreground black -data {
3795#define file_question_width 14
3796#define file_question_height 15
3797static unsigned char file_question_bits[] = {
3798   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3799   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3800   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3801} -maskdata $filemask
3802
3803image create bitmap file_removed -background white -foreground red -data {
3804#define file_removed_width 14
3805#define file_removed_height 15
3806static unsigned char file_removed_bits[] = {
3807   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3808   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3809   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3810} -maskdata $filemask
3811
3812image create bitmap file_merge -background white -foreground blue -data {
3813#define file_merge_width 14
3814#define file_merge_height 15
3815static unsigned char file_merge_bits[] = {
3816   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3817   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3818   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3819} -maskdata $filemask
3820
3821set file_dir_data {
3822#define file_width 18
3823#define file_height 18
3824static unsigned char file_bits[] = {
3825  0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3826  0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3827  0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3828  0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3829  0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3830}
3831image create bitmap file_dir -background white -foreground blue \
3832        -data $file_dir_data -maskdata $file_dir_data
3833unset file_dir_data
3834
3835set file_uplevel_data {
3836#define up_width 15
3837#define up_height 15
3838static unsigned char up_bits[] = {
3839  0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3840  0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3841  0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3842}
3843image create bitmap file_uplevel -background white -foreground red \
3844        -data $file_uplevel_data -maskdata $file_uplevel_data
3845unset file_uplevel_data
3846
3847set ui_index .vpane.files.index.list
3848set ui_workdir .vpane.files.workdir.list
3849
3850set all_icons(_$ui_index)   file_plain
3851set all_icons(A$ui_index)   file_fulltick
3852set all_icons(M$ui_index)   file_fulltick
3853set all_icons(D$ui_index)   file_removed
3854set all_icons(U$ui_index)   file_merge
3855
3856set all_icons(_$ui_workdir) file_plain
3857set all_icons(M$ui_workdir) file_mod
3858set all_icons(D$ui_workdir) file_question
3859set all_icons(U$ui_workdir) file_merge
3860set all_icons(O$ui_workdir) file_plain
3861
3862set max_status_desc 0
3863foreach i {
3864                {__ "Unmodified"}
3865
3866                {_M "Modified, not staged"}
3867                {M_ "Staged for commit"}
3868                {MM "Portions staged for commit"}
3869                {MD "Staged for commit, missing"}
3870
3871                {_O "Untracked, not staged"}
3872                {A_ "Staged for commit"}
3873                {AM "Portions staged for commit"}
3874                {AD "Staged for commit, missing"}
3875
3876                {_D "Missing"}
3877                {D_ "Staged for removal"}
3878                {DO "Staged for removal, still present"}
3879
3880                {U_ "Requires merge resolution"}
3881                {UU "Requires merge resolution"}
3882                {UM "Requires merge resolution"}
3883                {UD "Requires merge resolution"}
3884        } {
3885        if {$max_status_desc < [string length [lindex $i 1]]} {
3886                set max_status_desc [string length [lindex $i 1]]
3887        }
3888        set all_descs([lindex $i 0]) [lindex $i 1]
3889}
3890unset i
3891
3892######################################################################
3893##
3894## util
3895
3896proc bind_button3 {w cmd} {
3897        bind $w <Any-Button-3> $cmd
3898        if {[is_MacOSX]} {
3899                bind $w <Control-Button-1> $cmd
3900        }
3901}
3902
3903proc scrollbar2many {list mode args} {
3904        foreach w $list {eval $w $mode $args}
3905}
3906
3907proc many2scrollbar {list mode sb top bottom} {
3908        $sb set $top $bottom
3909        foreach w $list {$w $mode moveto $top}
3910}
3911
3912proc incr_font_size {font {amt 1}} {
3913        set sz [font configure $font -size]
3914        incr sz $amt
3915        font configure $font -size $sz
3916        font configure ${font}bold -size $sz
3917}
3918
3919proc hook_failed_popup {hook msg} {
3920        set w .hookfail
3921        toplevel $w
3922
3923        frame $w.m
3924        label $w.m.l1 -text "$hook hook failed:" \
3925                -anchor w \
3926                -justify left \
3927                -font font_uibold
3928        text $w.m.t \
3929                -background white -borderwidth 1 \
3930                -relief sunken \
3931                -width 80 -height 10 \
3932                -font font_diff \
3933                -yscrollcommand [list $w.m.sby set]
3934        label $w.m.l2 \
3935                -text {You must correct the above errors before committing.} \
3936                -anchor w \
3937                -justify left \
3938                -font font_uibold
3939        scrollbar $w.m.sby -command [list $w.m.t yview]
3940        pack $w.m.l1 -side top -fill x
3941        pack $w.m.l2 -side bottom -fill x
3942        pack $w.m.sby -side right -fill y
3943        pack $w.m.t -side left -fill both -expand 1
3944        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3945
3946        $w.m.t insert 1.0 $msg
3947        $w.m.t conf -state disabled
3948
3949        button $w.ok -text OK \
3950                -width 15 \
3951                -font font_ui \
3952                -command "destroy $w"
3953        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3954
3955        bind $w <Visibility> "grab $w; focus $w"
3956        bind $w <Key-Return> "destroy $w"
3957        wm title $w "[appname] ([reponame]): error"
3958        tkwait window $w
3959}
3960
3961set next_console_id 0
3962
3963proc new_console {short_title long_title} {
3964        global next_console_id console_data
3965        set w .console[incr next_console_id]
3966        set console_data($w) [list $short_title $long_title]
3967        return [console_init $w]
3968}
3969
3970proc console_init {w} {
3971        global console_cr console_data M1B
3972
3973        set console_cr($w) 1.0
3974        toplevel $w
3975        frame $w.m
3976        label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3977                -anchor w \
3978                -justify left \
3979                -font font_uibold
3980        text $w.m.t \
3981                -background white -borderwidth 1 \
3982                -relief sunken \
3983                -width 80 -height 10 \
3984                -font font_diff \
3985                -state disabled \
3986                -yscrollcommand [list $w.m.sby set]
3987        label $w.m.s -text {Working... please wait...} \
3988                -anchor w \
3989                -justify left \
3990                -font font_uibold
3991        scrollbar $w.m.sby -command [list $w.m.t yview]
3992        pack $w.m.l1 -side top -fill x
3993        pack $w.m.s -side bottom -fill x
3994        pack $w.m.sby -side right -fill y
3995        pack $w.m.t -side left -fill both -expand 1
3996        pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3997
3998        menu $w.ctxm -tearoff 0
3999        $w.ctxm add command -label "Copy" \
4000                -font font_ui \
4001                -command "tk_textCopy $w.m.t"
4002        $w.ctxm add command -label "Select All" \
4003                -font font_ui \
4004                -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
4005        $w.ctxm add command -label "Copy All" \
4006                -font font_ui \
4007                -command "
4008                        $w.m.t tag add sel 0.0 end
4009                        tk_textCopy $w.m.t
4010                        $w.m.t tag remove sel 0.0 end
4011                "
4012
4013        button $w.ok -text {Close} \
4014                -font font_ui \
4015                -state disabled \
4016                -command "destroy $w"
4017        pack $w.ok -side bottom -anchor e -pady 10 -padx 10
4018
4019        bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
4020        bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
4021        bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
4022        bind $w <Visibility> "focus $w"
4023        wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
4024        return $w
4025}
4026
4027proc console_exec {w cmd after} {
4028        # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4029        #    But most users need that so we have to relogin. :-(
4030        #
4031        if {[is_Cygwin]} {
4032                set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
4033        }
4034
4035        # -- Tcl won't let us redirect both stdout and stderr to
4036        #    the same pipe.  So pass it through cat...
4037        #
4038        set cmd [concat | $cmd |& cat]
4039
4040        set fd_f [open $cmd r]
4041        fconfigure $fd_f -blocking 0 -translation binary
4042        fileevent $fd_f readable [list console_read $w $fd_f $after]
4043}
4044
4045proc console_read {w fd after} {
4046        global console_cr
4047
4048        set buf [read $fd]
4049        if {$buf ne {}} {
4050                if {![winfo exists $w]} {console_init $w}
4051                $w.m.t conf -state normal
4052                set c 0
4053                set n [string length $buf]
4054                while {$c < $n} {
4055                        set cr [string first "\r" $buf $c]
4056                        set lf [string first "\n" $buf $c]
4057                        if {$cr < 0} {set cr [expr {$n + 1}]}
4058                        if {$lf < 0} {set lf [expr {$n + 1}]}
4059
4060                        if {$lf < $cr} {
4061                                $w.m.t insert end [string range $buf $c $lf]
4062                                set console_cr($w) [$w.m.t index {end -1c}]
4063                                set c $lf
4064                                incr c
4065                        } else {
4066                                $w.m.t delete $console_cr($w) end
4067                                $w.m.t insert end "\n"
4068                                $w.m.t insert end [string range $buf $c $cr]
4069                                set c $cr
4070                                incr c
4071                        }
4072                }
4073                $w.m.t conf -state disabled
4074                $w.m.t see end
4075        }
4076
4077        fconfigure $fd -blocking 1
4078        if {[eof $fd]} {
4079                if {[catch {close $fd}]} {
4080                        set ok 0
4081                } else {
4082                        set ok 1
4083                }
4084                uplevel #0 $after $w $ok
4085                return
4086        }
4087        fconfigure $fd -blocking 0
4088}
4089
4090proc console_chain {cmdlist w {ok 1}} {
4091        if {$ok} {
4092                if {[llength $cmdlist] == 0} {
4093                        console_done $w $ok
4094                        return
4095                }
4096
4097                set cmd [lindex $cmdlist 0]
4098                set cmdlist [lrange $cmdlist 1 end]
4099
4100                if {[lindex $cmd 0] eq {console_exec}} {
4101                        console_exec $w \
4102                                [lindex $cmd 1] \
4103                                [list console_chain $cmdlist]
4104                } else {
4105                        uplevel #0 $cmd $cmdlist $w $ok
4106                }
4107        } else {
4108                console_done $w $ok
4109        }
4110}
4111
4112proc console_done {args} {
4113        global console_cr console_data
4114
4115        switch -- [llength $args] {
4116        2 {
4117                set w [lindex $args 0]
4118                set ok [lindex $args 1]
4119        }
4120        3 {
4121                set w [lindex $args 1]
4122                set ok [lindex $args 2]
4123        }
4124        default {
4125                error "wrong number of args: console_done ?ignored? w ok"
4126        }
4127        }
4128
4129        if {$ok} {
4130                if {[winfo exists $w]} {
4131                        $w.m.s conf -background green -text {Success}
4132                        $w.ok conf -state normal
4133                        focus $w.ok
4134                }
4135        } else {
4136                if {![winfo exists $w]} {
4137                        console_init $w
4138                }
4139                $w.m.s conf -background red -text {Error: Command Failed}
4140                $w.ok conf -state normal
4141                focus $w.ok
4142        }
4143
4144        array unset console_cr $w
4145        array unset console_data $w
4146}
4147
4148######################################################################
4149##
4150## ui commands
4151
4152set starting_gitk_msg {Starting gitk... please wait...}
4153
4154proc do_gitk {revs} {
4155        global env ui_status_value starting_gitk_msg
4156
4157        # -- Always start gitk through whatever we were loaded with.  This
4158        #    lets us bypass using shell process on Windows systems.
4159        #
4160        set cmd [list [info nameofexecutable]]
4161        lappend cmd [gitexec gitk]
4162        if {$revs ne {}} {
4163                append cmd { }
4164                append cmd $revs
4165        }
4166
4167        if {[catch {eval exec $cmd &} err]} {
4168                error_popup "Failed to start gitk:\n\n$err"
4169        } else {
4170                set ui_status_value $starting_gitk_msg
4171                after 10000 {
4172                        if {$ui_status_value eq $starting_gitk_msg} {
4173                                set ui_status_value {Ready.}
4174                        }
4175                }
4176        }
4177}
4178
4179proc do_stats {} {
4180        set fd [open "| git count-objects -v" r]
4181        while {[gets $fd line] > 0} {
4182                if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4183                        set stats($name) $value
4184                }
4185        }
4186        close $fd
4187
4188        set packed_sz 0
4189        foreach p [glob -directory [gitdir objects pack] \
4190                -type f \
4191                -nocomplain -- *] {
4192                incr packed_sz [file size $p]
4193        }
4194        if {$packed_sz > 0} {
4195                set stats(size-pack) [expr {$packed_sz / 1024}]
4196        }
4197
4198        set w .stats_view
4199        toplevel $w
4200        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4201
4202        label $w.header -text {Database Statistics} \
4203                -font font_uibold
4204        pack $w.header -side top -fill x
4205
4206        frame $w.buttons -border 1
4207        button $w.buttons.close -text Close \
4208                -font font_ui \
4209                -default active \
4210                -command [list destroy $w]
4211        button $w.buttons.gc -text {Compress Database} \
4212                -font font_ui \
4213                -default normal \
4214                -command "destroy $w;do_gc"
4215        pack $w.buttons.close -side right
4216        pack $w.buttons.gc -side left
4217        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4218
4219        frame $w.stat -borderwidth 1 -relief solid
4220        foreach s {
4221                {count           {Number of loose objects}}
4222                {size            {Disk space used by loose objects} { KiB}}
4223                {in-pack         {Number of packed objects}}
4224                {packs           {Number of packs}}
4225                {size-pack       {Disk space used by packed objects} { KiB}}
4226                {prune-packable  {Packed objects waiting for pruning}}
4227                {garbage         {Garbage files}}
4228                } {
4229                set name [lindex $s 0]
4230                set label [lindex $s 1]
4231                if {[catch {set value $stats($name)}]} continue
4232                if {[llength $s] > 2} {
4233                        set value "$value[lindex $s 2]"
4234                }
4235
4236                label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4237                label $w.stat.v_$name -text $value -anchor w -font font_ui
4238                grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4239        }
4240        pack $w.stat -pady 10 -padx 10
4241
4242        bind $w <Visibility> "grab $w; focus $w.buttons.close"
4243        bind $w <Key-Escape> [list destroy $w]
4244        bind $w <Key-Return> [list destroy $w]
4245        wm title $w "[appname] ([reponame]): Database Statistics"
4246        tkwait window $w
4247}
4248
4249proc do_gc {} {
4250        set w [new_console {gc} {Compressing the object database}]
4251        console_chain {
4252                {console_exec {git pack-refs --prune}}
4253                {console_exec {git reflog expire --all}}
4254                {console_exec {git repack -a -d -l}}
4255                {console_exec {git rerere gc}}
4256        } $w
4257}
4258
4259proc do_fsck_objects {} {
4260        set w [new_console {fsck-objects} \
4261                {Verifying the object database with fsck-objects}]
4262        set cmd [list git fsck-objects]
4263        lappend cmd --full
4264        lappend cmd --cache
4265        lappend cmd --strict
4266        console_exec $w $cmd console_done
4267}
4268
4269set is_quitting 0
4270
4271proc do_quit {} {
4272        global ui_comm is_quitting repo_config commit_type
4273
4274        if {$is_quitting} return
4275        set is_quitting 1
4276
4277        if {[winfo exists $ui_comm]} {
4278                # -- Stash our current commit buffer.
4279                #
4280                set save [gitdir GITGUI_MSG]
4281                set msg [string trim [$ui_comm get 0.0 end]]
4282                regsub -all -line {[ \r\t]+$} $msg {} msg
4283                if {(![string match amend* $commit_type]
4284                        || [$ui_comm edit modified])
4285                        && $msg ne {}} {
4286                        catch {
4287                                set fd [open $save w]
4288                                puts -nonewline $fd $msg
4289                                close $fd
4290                        }
4291                } else {
4292                        catch {file delete $save}
4293                }
4294
4295                # -- Stash our current window geometry into this repository.
4296                #
4297                set cfg_geometry [list]
4298                lappend cfg_geometry [wm geometry .]
4299                lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4300                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4301                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4302                        set rc_geometry {}
4303                }
4304                if {$cfg_geometry ne $rc_geometry} {
4305                        catch {git config gui.geometry $cfg_geometry}
4306                }
4307        }
4308
4309        destroy .
4310}
4311
4312proc do_rescan {} {
4313        rescan {set ui_status_value {Ready.}}
4314}
4315
4316proc unstage_helper {txt paths} {
4317        global file_states current_diff_path
4318
4319        if {![lock_index begin-update]} return
4320
4321        set pathList [list]
4322        set after {}
4323        foreach path $paths {
4324                switch -glob -- [lindex $file_states($path) 0] {
4325                A? -
4326                M? -
4327                D? {
4328                        lappend pathList $path
4329                        if {$path eq $current_diff_path} {
4330                                set after {reshow_diff;}
4331                        }
4332                }
4333                }
4334        }
4335        if {$pathList eq {}} {
4336                unlock_index
4337        } else {
4338                update_indexinfo \
4339                        $txt \
4340                        $pathList \
4341                        [concat $after {set ui_status_value {Ready.}}]
4342        }
4343}
4344
4345proc do_unstage_selection {} {
4346        global current_diff_path selected_paths
4347
4348        if {[array size selected_paths] > 0} {
4349                unstage_helper \
4350                        {Unstaging selected files from commit} \
4351                        [array names selected_paths]
4352        } elseif {$current_diff_path ne {}} {
4353                unstage_helper \
4354                        "Unstaging [short_path $current_diff_path] from commit" \
4355                        [list $current_diff_path]
4356        }
4357}
4358
4359proc add_helper {txt paths} {
4360        global file_states current_diff_path
4361
4362        if {![lock_index begin-update]} return
4363
4364        set pathList [list]
4365        set after {}
4366        foreach path $paths {
4367                switch -glob -- [lindex $file_states($path) 0] {
4368                _O -
4369                ?M -
4370                ?D -
4371                U? {
4372                        lappend pathList $path
4373                        if {$path eq $current_diff_path} {
4374                                set after {reshow_diff;}
4375                        }
4376                }
4377                }
4378        }
4379        if {$pathList eq {}} {
4380                unlock_index
4381        } else {
4382                update_index \
4383                        $txt \
4384                        $pathList \
4385                        [concat $after {set ui_status_value {Ready to commit.}}]
4386        }
4387}
4388
4389proc do_add_selection {} {
4390        global current_diff_path selected_paths
4391
4392        if {[array size selected_paths] > 0} {
4393                add_helper \
4394                        {Adding selected files} \
4395                        [array names selected_paths]
4396        } elseif {$current_diff_path ne {}} {
4397                add_helper \
4398                        "Adding [short_path $current_diff_path]" \
4399                        [list $current_diff_path]
4400        }
4401}
4402
4403proc do_add_all {} {
4404        global file_states
4405
4406        set paths [list]
4407        foreach path [array names file_states] {
4408                switch -glob -- [lindex $file_states($path) 0] {
4409                U? {continue}
4410                ?M -
4411                ?D {lappend paths $path}
4412                }
4413        }
4414        add_helper {Adding all changed files} $paths
4415}
4416
4417proc revert_helper {txt paths} {
4418        global file_states current_diff_path
4419
4420        if {![lock_index begin-update]} return
4421
4422        set pathList [list]
4423        set after {}
4424        foreach path $paths {
4425                switch -glob -- [lindex $file_states($path) 0] {
4426                U? {continue}
4427                ?M -
4428                ?D {
4429                        lappend pathList $path
4430                        if {$path eq $current_diff_path} {
4431                                set after {reshow_diff;}
4432                        }
4433                }
4434                }
4435        }
4436
4437        set n [llength $pathList]
4438        if {$n == 0} {
4439                unlock_index
4440                return
4441        } elseif {$n == 1} {
4442                set s "[short_path [lindex $pathList]]"
4443        } else {
4444                set s "these $n files"
4445        }
4446
4447        set reply [tk_dialog \
4448                .confirm_revert \
4449                "[appname] ([reponame])" \
4450                "Revert changes in $s?
4451
4452Any unadded changes will be permanently lost by the revert." \
4453                question \
4454                1 \
4455                {Do Nothing} \
4456                {Revert Changes} \
4457                ]
4458        if {$reply == 1} {
4459                checkout_index \
4460                        $txt \
4461                        $pathList \
4462                        [concat $after {set ui_status_value {Ready.}}]
4463        } else {
4464                unlock_index
4465        }
4466}
4467
4468proc do_revert_selection {} {
4469        global current_diff_path selected_paths
4470
4471        if {[array size selected_paths] > 0} {
4472                revert_helper \
4473                        {Reverting selected files} \
4474                        [array names selected_paths]
4475        } elseif {$current_diff_path ne {}} {
4476                revert_helper \
4477                        "Reverting [short_path $current_diff_path]" \
4478                        [list $current_diff_path]
4479        }
4480}
4481
4482proc do_signoff {} {
4483        global ui_comm
4484
4485        set me [committer_ident]
4486        if {$me eq {}} return
4487
4488        set sob "Signed-off-by: $me"
4489        set last [$ui_comm get {end -1c linestart} {end -1c}]
4490        if {$last ne $sob} {
4491                $ui_comm edit separator
4492                if {$last ne {}
4493                        && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4494                        $ui_comm insert end "\n"
4495                }
4496                $ui_comm insert end "\n$sob"
4497                $ui_comm edit separator
4498                $ui_comm see end
4499        }
4500}
4501
4502proc do_select_commit_type {} {
4503        global commit_type selected_commit_type
4504
4505        if {$selected_commit_type eq {new}
4506                && [string match amend* $commit_type]} {
4507                create_new_commit
4508        } elseif {$selected_commit_type eq {amend}
4509                && ![string match amend* $commit_type]} {
4510                load_last_commit
4511
4512                # The amend request was rejected...
4513                #
4514                if {![string match amend* $commit_type]} {
4515                        set selected_commit_type new
4516                }
4517        }
4518}
4519
4520proc do_commit {} {
4521        commit_tree
4522}
4523
4524proc do_about {} {
4525        global appvers copyright
4526        global tcl_patchLevel tk_patchLevel
4527
4528        set w .about_dialog
4529        toplevel $w
4530        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4531
4532        label $w.header -text "About [appname]" \
4533                -font font_uibold
4534        pack $w.header -side top -fill x
4535
4536        frame $w.buttons
4537        button $w.buttons.close -text {Close} \
4538                -font font_ui \
4539                -default active \
4540                -command [list destroy $w]
4541        pack $w.buttons.close -side right
4542        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4543
4544        label $w.desc \
4545                -text "git-gui - a graphical user interface for Git.
4546$copyright" \
4547                -padx 5 -pady 5 \
4548                -justify left \
4549                -anchor w \
4550                -borderwidth 1 \
4551                -relief solid \
4552                -font font_ui
4553        pack $w.desc -side top -fill x -padx 5 -pady 5
4554
4555        set v {}
4556        append v "git-gui version $appvers\n"
4557        append v "[git version]\n"
4558        append v "\n"
4559        if {$tcl_patchLevel eq $tk_patchLevel} {
4560                append v "Tcl/Tk version $tcl_patchLevel"
4561        } else {
4562                append v "Tcl version $tcl_patchLevel"
4563                append v ", Tk version $tk_patchLevel"
4564        }
4565
4566        label $w.vers \
4567                -text $v \
4568                -padx 5 -pady 5 \
4569                -justify left \
4570                -anchor w \
4571                -borderwidth 1 \
4572                -relief solid \
4573                -font font_ui
4574        pack $w.vers -side top -fill x -padx 5 -pady 5
4575
4576        menu $w.ctxm -tearoff 0
4577        $w.ctxm add command \
4578                -label {Copy} \
4579                -font font_ui \
4580                -command "
4581                clipboard clear
4582                clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4583        "
4584
4585        bind $w <Visibility> "grab $w; focus $w.buttons.close"
4586        bind $w <Key-Escape> "destroy $w"
4587        bind $w <Key-Return> "destroy $w"
4588        bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4589        wm title $w "About [appname]"
4590        tkwait window $w
4591}
4592
4593proc do_options {} {
4594        global repo_config global_config font_descs
4595        global repo_config_new global_config_new
4596
4597        array unset repo_config_new
4598        array unset global_config_new
4599        foreach name [array names repo_config] {
4600                set repo_config_new($name) $repo_config($name)
4601        }
4602        load_config 1
4603        foreach name [array names repo_config] {
4604                switch -- $name {
4605                gui.diffcontext {continue}
4606                }
4607                set repo_config_new($name) $repo_config($name)
4608        }
4609        foreach name [array names global_config] {
4610                set global_config_new($name) $global_config($name)
4611        }
4612
4613        set w .options_editor
4614        toplevel $w
4615        wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4616
4617        label $w.header -text "Options" \
4618                -font font_uibold
4619        pack $w.header -side top -fill x
4620
4621        frame $w.buttons
4622        button $w.buttons.restore -text {Restore Defaults} \
4623                -font font_ui \
4624                -default normal \
4625                -command do_restore_defaults
4626        pack $w.buttons.restore -side left
4627        button $w.buttons.save -text Save \
4628                -font font_ui \
4629                -default active \
4630                -command [list do_save_config $w]
4631        pack $w.buttons.save -side right
4632        button $w.buttons.cancel -text {Cancel} \
4633                -font font_ui \
4634                -default normal \
4635                -command [list destroy $w]
4636        pack $w.buttons.cancel -side right -padx 5
4637        pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4638
4639        labelframe $w.repo -text "[reponame] Repository" \
4640                -font font_ui
4641        labelframe $w.global -text {Global (All Repositories)} \
4642                -font font_ui
4643        pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4644        pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4645
4646        set optid 0
4647        foreach option {
4648                {t user.name {User Name}}
4649                {t user.email {Email Address}}
4650
4651                {b merge.summary {Summarize Merge Commits}}
4652                {i-1..5 merge.verbosity {Merge Verbosity}}
4653
4654                {b gui.trustmtime  {Trust File Modification Timestamps}}
4655                {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4656                {t gui.newbranchtemplate {New Branch Name Template}}
4657                } {
4658                set type [lindex $option 0]
4659                set name [lindex $option 1]
4660                set text [lindex $option 2]
4661                incr optid
4662                foreach f {repo global} {
4663                        switch -glob -- $type {
4664                        b {
4665                                checkbutton $w.$f.$optid -text $text \
4666                                        -variable ${f}_config_new($name) \
4667                                        -onvalue true \
4668                                        -offvalue false \
4669                                        -font font_ui
4670                                pack $w.$f.$optid -side top -anchor w
4671                        }
4672                        i-* {
4673                                regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4674                                frame $w.$f.$optid
4675                                label $w.$f.$optid.l -text "$text:" -font font_ui
4676                                pack $w.$f.$optid.l -side left -anchor w -fill x
4677                                spinbox $w.$f.$optid.v \
4678                                        -textvariable ${f}_config_new($name) \
4679                                        -from $min \
4680                                        -to $max \
4681                                        -increment 1 \
4682                                        -width [expr {1 + [string length $max]}] \
4683                                        -font font_ui
4684                                bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4685                                pack $w.$f.$optid.v -side right -anchor e -padx 5
4686                                pack $w.$f.$optid -side top -anchor w -fill x
4687                        }
4688                        t {
4689                                frame $w.$f.$optid
4690                                label $w.$f.$optid.l -text "$text:" -font font_ui
4691                                entry $w.$f.$optid.v \
4692                                        -borderwidth 1 \
4693                                        -relief sunken \
4694                                        -width 20 \
4695                                        -textvariable ${f}_config_new($name) \
4696                                        -font font_ui
4697                                pack $w.$f.$optid.l -side left -anchor w
4698                                pack $w.$f.$optid.v -side left -anchor w \
4699                                        -fill x -expand 1 \
4700                                        -padx 5
4701                                pack $w.$f.$optid -side top -anchor w -fill x
4702                        }
4703                        }
4704                }
4705        }
4706
4707        set all_fonts [lsort [font families]]
4708        foreach option $font_descs {
4709                set name [lindex $option 0]
4710                set font [lindex $option 1]
4711                set text [lindex $option 2]
4712
4713                set global_config_new(gui.$font^^family) \
4714                        [font configure $font -family]
4715                set global_config_new(gui.$font^^size) \
4716                        [font configure $font -size]
4717
4718                frame $w.global.$name
4719                label $w.global.$name.l -text "$text:" -font font_ui
4720                pack $w.global.$name.l -side left -anchor w -fill x
4721                set fontmenu [eval tk_optionMenu $w.global.$name.family \
4722                        global_config_new(gui.$font^^family) \
4723                        $all_fonts]
4724                $w.global.$name.family configure -font font_ui
4725                $fontmenu configure -font font_ui
4726                spinbox $w.global.$name.size \
4727                        -textvariable global_config_new(gui.$font^^size) \
4728                        -from 2 -to 80 -increment 1 \
4729                        -width 3 \
4730                        -font font_ui
4731                bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4732                pack $w.global.$name.size -side right -anchor e
4733                pack $w.global.$name.family -side right -anchor e
4734                pack $w.global.$name -side top -anchor w -fill x
4735        }
4736
4737        bind $w <Visibility> "grab $w; focus $w.buttons.save"
4738        bind $w <Key-Escape> "destroy $w"
4739        bind $w <Key-Return> [list do_save_config $w]
4740        wm title $w "[appname] ([reponame]): Options"
4741        tkwait window $w
4742}
4743
4744proc do_restore_defaults {} {
4745        global font_descs default_config repo_config
4746        global repo_config_new global_config_new
4747
4748        foreach name [array names default_config] {
4749                set repo_config_new($name) $default_config($name)
4750                set global_config_new($name) $default_config($name)
4751        }
4752
4753        foreach option $font_descs {
4754                set name [lindex $option 0]
4755                set repo_config(gui.$name) $default_config(gui.$name)
4756        }
4757        apply_config
4758
4759        foreach option $font_descs {
4760                set name [lindex $option 0]
4761                set font [lindex $option 1]
4762                set global_config_new(gui.$font^^family) \
4763                        [font configure $font -family]
4764                set global_config_new(gui.$font^^size) \
4765                        [font configure $font -size]
4766        }
4767}
4768
4769proc do_save_config {w} {
4770        if {[catch {save_config} err]} {
4771                error_popup "Failed to completely save options:\n\n$err"
4772        }
4773        reshow_diff
4774        destroy $w
4775}
4776
4777proc do_windows_shortcut {} {
4778        global argv0
4779
4780        set fn [tk_getSaveFile \
4781                -parent . \
4782                -title "[appname] ([reponame]): Create Desktop Icon" \
4783                -initialfile "Git [reponame].bat"]
4784        if {$fn != {}} {
4785                if {[catch {
4786                                set fd [open $fn w]
4787                                puts $fd "@ECHO Entering [reponame]"
4788                                puts $fd "@ECHO Starting git-gui... please wait..."
4789                                puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4790                                puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4791                                puts -nonewline $fd "@\"[info nameofexecutable]\""
4792                                puts $fd " \"[file normalize $argv0]\""
4793                                close $fd
4794                        } err]} {
4795                        error_popup "Cannot write script:\n\n$err"
4796                }
4797        }
4798}
4799
4800proc do_cygwin_shortcut {} {
4801        global argv0
4802
4803        if {[catch {
4804                set desktop [exec cygpath \
4805                        --windows \
4806                        --absolute \
4807                        --long-name \
4808                        --desktop]
4809                }]} {
4810                        set desktop .
4811        }
4812        set fn [tk_getSaveFile \
4813                -parent . \
4814                -title "[appname] ([reponame]): Create Desktop Icon" \
4815                -initialdir $desktop \
4816                -initialfile "Git [reponame].bat"]
4817        if {$fn != {}} {
4818                if {[catch {
4819                                set fd [open $fn w]
4820                                set sh [exec cygpath \
4821                                        --windows \
4822                                        --absolute \
4823                                        /bin/sh]
4824                                set me [exec cygpath \
4825                                        --unix \
4826                                        --absolute \
4827                                        $argv0]
4828                                set gd [exec cygpath \
4829                                        --unix \
4830                                        --absolute \
4831                                        [gitdir]]
4832                                set gw [exec cygpath \
4833                                        --windows \
4834                                        --absolute \
4835                                        [file dirname [gitdir]]]
4836                                regsub -all ' $me "'\\''" me
4837                                regsub -all ' $gd "'\\''" gd
4838                                puts $fd "@ECHO Entering $gw"
4839                                puts $fd "@ECHO Starting git-gui... please wait..."
4840                                puts -nonewline $fd "@\"$sh\" --login -c \""
4841                                puts -nonewline $fd "GIT_DIR='$gd'"
4842                                puts -nonewline $fd " '$me'"
4843                                puts $fd "&\""
4844                                close $fd
4845                        } err]} {
4846                        error_popup "Cannot write script:\n\n$err"
4847                }
4848        }
4849}
4850
4851proc do_macosx_app {} {
4852        global argv0 env
4853
4854        set fn [tk_getSaveFile \
4855                -parent . \
4856                -title "[appname] ([reponame]): Create Desktop Icon" \
4857                -initialdir [file join $env(HOME) Desktop] \
4858                -initialfile "Git [reponame].app"]
4859        if {$fn != {}} {
4860                if {[catch {
4861                                set Contents [file join $fn Contents]
4862                                set MacOS [file join $Contents MacOS]
4863                                set exe [file join $MacOS git-gui]
4864
4865                                file mkdir $MacOS
4866
4867                                set fd [open [file join $Contents Info.plist] w]
4868                                puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4869<!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4870<plist version="1.0">
4871<dict>
4872        <key>CFBundleDevelopmentRegion</key>
4873        <string>English</string>
4874        <key>CFBundleExecutable</key>
4875        <string>git-gui</string>
4876        <key>CFBundleIdentifier</key>
4877        <string>org.spearce.git-gui</string>
4878        <key>CFBundleInfoDictionaryVersion</key>
4879        <string>6.0</string>
4880        <key>CFBundlePackageType</key>
4881        <string>APPL</string>
4882        <key>CFBundleSignature</key>
4883        <string>????</string>
4884        <key>CFBundleVersion</key>
4885        <string>1.0</string>
4886        <key>NSPrincipalClass</key>
4887        <string>NSApplication</string>
4888</dict>
4889</plist>}
4890                                close $fd
4891
4892                                set fd [open $exe w]
4893                                set gd [file normalize [gitdir]]
4894                                set ep [file normalize [gitexec]]
4895                                regsub -all ' $gd "'\\''" gd
4896                                regsub -all ' $ep "'\\''" ep
4897                                puts $fd "#!/bin/sh"
4898                                foreach name [array names env] {
4899                                        if {[string match GIT_* $name]} {
4900                                                regsub -all ' $env($name) "'\\''" v
4901                                                puts $fd "export $name='$v'"
4902                                        }
4903                                }
4904                                puts $fd "export PATH='$ep':\$PATH"
4905                                puts $fd "export GIT_DIR='$gd'"
4906                                puts $fd "exec [file normalize $argv0]"
4907                                close $fd
4908
4909                                file attributes $exe -permissions u+x,g+x,o+x
4910                        } err]} {
4911                        error_popup "Cannot write icon:\n\n$err"
4912                }
4913        }
4914}
4915
4916proc toggle_or_diff {w x y} {
4917        global file_states file_lists current_diff_path ui_index ui_workdir
4918        global last_clicked selected_paths
4919
4920        set pos [split [$w index @$x,$y] .]
4921        set lno [lindex $pos 0]
4922        set col [lindex $pos 1]
4923        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4924        if {$path eq {}} {
4925                set last_clicked {}
4926                return
4927        }
4928
4929        set last_clicked [list $w $lno]
4930        array unset selected_paths
4931        $ui_index tag remove in_sel 0.0 end
4932        $ui_workdir tag remove in_sel 0.0 end
4933
4934        if {$col == 0} {
4935                if {$current_diff_path eq $path} {
4936                        set after {reshow_diff;}
4937                } else {
4938                        set after {}
4939                }
4940                if {$w eq $ui_index} {
4941                        update_indexinfo \
4942                                "Unstaging [short_path $path] from commit" \
4943                                [list $path] \
4944                                [concat $after {set ui_status_value {Ready.}}]
4945                } elseif {$w eq $ui_workdir} {
4946                        update_index \
4947                                "Adding [short_path $path]" \
4948                                [list $path] \
4949                                [concat $after {set ui_status_value {Ready.}}]
4950                }
4951        } else {
4952                show_diff $path $w $lno
4953        }
4954}
4955
4956proc add_one_to_selection {w x y} {
4957        global file_lists last_clicked selected_paths
4958
4959        set lno [lindex [split [$w index @$x,$y] .] 0]
4960        set path [lindex $file_lists($w) [expr {$lno - 1}]]
4961        if {$path eq {}} {
4962                set last_clicked {}
4963                return
4964        }
4965
4966        if {$last_clicked ne {}
4967                && [lindex $last_clicked 0] ne $w} {
4968                array unset selected_paths
4969                [lindex $last_clicked 0] tag remove in_sel 0.0 end
4970        }
4971
4972        set last_clicked [list $w $lno]
4973        if {[catch {set in_sel $selected_paths($path)}]} {
4974                set in_sel 0
4975        }
4976        if {$in_sel} {
4977                unset selected_paths($path)
4978                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4979        } else {
4980                set selected_paths($path) 1
4981                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4982        }
4983}
4984
4985proc add_range_to_selection {w x y} {
4986        global file_lists last_clicked selected_paths
4987
4988        if {[lindex $last_clicked 0] ne $w} {
4989                toggle_or_diff $w $x $y
4990                return
4991        }
4992
4993        set lno [lindex [split [$w index @$x,$y] .] 0]
4994        set lc [lindex $last_clicked 1]
4995        if {$lc < $lno} {
4996                set begin $lc
4997                set end $lno
4998        } else {
4999                set begin $lno
5000                set end $lc
5001        }
5002
5003        foreach path [lrange $file_lists($w) \
5004                [expr {$begin - 1}] \
5005                [expr {$end - 1}]] {
5006                set selected_paths($path) 1
5007        }
5008        $w tag add in_sel $begin.0 [expr {$end + 1}].0
5009}
5010
5011######################################################################
5012##
5013## config defaults
5014
5015set cursor_ptr arrow
5016font create font_diff -family Courier -size 10
5017font create font_ui
5018catch {
5019        label .dummy
5020        eval font configure font_ui [font actual [.dummy cget -font]]
5021        destroy .dummy
5022}
5023
5024font create font_uibold
5025font create font_diffbold
5026
5027if {[is_Windows]} {
5028        set M1B Control
5029        set M1T Ctrl
5030} elseif {[is_MacOSX]} {
5031        set M1B M1
5032        set M1T Cmd
5033} else {
5034        set M1B M1
5035        set M1T M1
5036}
5037
5038proc apply_config {} {
5039        global repo_config font_descs
5040
5041        foreach option $font_descs {
5042                set name [lindex $option 0]
5043                set font [lindex $option 1]
5044                if {[catch {
5045                        foreach {cn cv} $repo_config(gui.$name) {
5046                                font configure $font $cn $cv
5047                        }
5048                        } err]} {
5049                        error_popup "Invalid font specified in gui.$name:\n\n$err"
5050                }
5051                foreach {cn cv} [font configure $font] {
5052                        font configure ${font}bold $cn $cv
5053                }
5054                font configure ${font}bold -weight bold
5055        }
5056}
5057
5058set default_config(merge.summary) false
5059set default_config(merge.verbosity) 2
5060set default_config(user.name) {}
5061set default_config(user.email) {}
5062
5063set default_config(gui.trustmtime) false
5064set default_config(gui.diffcontext) 5
5065set default_config(gui.newbranchtemplate) {}
5066set default_config(gui.fontui) [font configure font_ui]
5067set default_config(gui.fontdiff) [font configure font_diff]
5068set font_descs {
5069        {fontui   font_ui   {Main Font}}
5070        {fontdiff font_diff {Diff/Console Font}}
5071}
5072load_config 0
5073apply_config
5074
5075######################################################################
5076##
5077## feature option selection
5078
5079if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5080        unset _junk
5081} else {
5082        set subcommand gui
5083}
5084if {$subcommand eq {gui.sh}} {
5085        set subcommand gui
5086}
5087if {$subcommand eq {gui} && [llength $argv] > 0} {
5088        set subcommand [lindex $argv 0]
5089        set argv [lrange $argv 1 end]
5090}
5091
5092enable_option multicommit
5093enable_option branch
5094enable_option transport
5095
5096switch -- $subcommand {
5097browser -
5098blame {
5099        disable_option multicommit
5100        disable_option branch
5101        disable_option transport
5102}
5103citool {
5104        enable_option singlecommit
5105
5106        disable_option multicommit
5107        disable_option branch
5108        disable_option transport
5109}
5110}
5111
5112######################################################################
5113##
5114## ui construction
5115
5116set ui_comm {}
5117
5118# -- Menu Bar
5119#
5120menu .mbar -tearoff 0
5121.mbar add cascade -label Repository -menu .mbar.repository -font font_ui
5122.mbar add cascade -label Edit -menu .mbar.edit -font font_ui
5123if {[is_enabled branch]} {
5124        .mbar add cascade -label Branch -menu .mbar.branch -font font_ui
5125}
5126if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5127        .mbar add cascade -label Commit -menu .mbar.commit -font font_ui
5128}
5129if {[is_enabled transport]} {
5130        .mbar add cascade -label Merge -menu .mbar.merge -font font_ui
5131        .mbar add cascade -label Fetch -menu .mbar.fetch -font font_ui
5132        .mbar add cascade -label Push -menu .mbar.push -font font_ui
5133}
5134. configure -menu .mbar
5135
5136# -- Repository Menu
5137#
5138menu .mbar.repository
5139
5140.mbar.repository add command \
5141        -label {Browse Current Branch} \
5142        -command {new_browser $current_branch} \
5143        -font font_ui
5144trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5145.mbar.repository add separator
5146
5147.mbar.repository add command \
5148        -label {Visualize Current Branch} \
5149        -command {do_gitk $current_branch} \
5150        -font font_ui
5151trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5152.mbar.repository add command \
5153        -label {Visualize All Branches} \
5154        -command {do_gitk --all} \
5155        -font font_ui
5156.mbar.repository add separator
5157
5158if {[is_enabled multicommit]} {
5159        .mbar.repository add command -label {Database Statistics} \
5160                -command do_stats \
5161                -font font_ui
5162
5163        .mbar.repository add command -label {Compress Database} \
5164                -command do_gc \
5165                -font font_ui
5166
5167        .mbar.repository add command -label {Verify Database} \
5168                -command do_fsck_objects \
5169                -font font_ui
5170
5171        .mbar.repository add separator
5172
5173        if {[is_Cygwin]} {
5174                .mbar.repository add command \
5175                        -label {Create Desktop Icon} \
5176                        -command do_cygwin_shortcut \
5177                        -font font_ui
5178        } elseif {[is_Windows]} {
5179                .mbar.repository add command \
5180                        -label {Create Desktop Icon} \
5181                        -command do_windows_shortcut \
5182                        -font font_ui
5183        } elseif {[is_MacOSX]} {
5184                .mbar.repository add command \
5185                        -label {Create Desktop Icon} \
5186                        -command do_macosx_app \
5187                        -font font_ui
5188        }
5189}
5190
5191.mbar.repository add command -label Quit \
5192        -command do_quit \
5193        -accelerator $M1T-Q \
5194        -font font_ui
5195
5196# -- Edit Menu
5197#
5198menu .mbar.edit
5199.mbar.edit add command -label Undo \
5200        -command {catch {[focus] edit undo}} \
5201        -accelerator $M1T-Z \
5202        -font font_ui
5203.mbar.edit add command -label Redo \
5204        -command {catch {[focus] edit redo}} \
5205        -accelerator $M1T-Y \
5206        -font font_ui
5207.mbar.edit add separator
5208.mbar.edit add command -label Cut \
5209        -command {catch {tk_textCut [focus]}} \
5210        -accelerator $M1T-X \
5211        -font font_ui
5212.mbar.edit add command -label Copy \
5213        -command {catch {tk_textCopy [focus]}} \
5214        -accelerator $M1T-C \
5215        -font font_ui
5216.mbar.edit add command -label Paste \
5217        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5218        -accelerator $M1T-V \
5219        -font font_ui
5220.mbar.edit add command -label Delete \
5221        -command {catch {[focus] delete sel.first sel.last}} \
5222        -accelerator Del \
5223        -font font_ui
5224.mbar.edit add separator
5225.mbar.edit add command -label {Select All} \
5226        -command {catch {[focus] tag add sel 0.0 end}} \
5227        -accelerator $M1T-A \
5228        -font font_ui
5229
5230# -- Branch Menu
5231#
5232if {[is_enabled branch]} {
5233        menu .mbar.branch
5234
5235        .mbar.branch add command -label {Create...} \
5236                -command do_create_branch \
5237                -accelerator $M1T-N \
5238                -font font_ui
5239        lappend disable_on_lock [list .mbar.branch entryconf \
5240                [.mbar.branch index last] -state]
5241
5242        .mbar.branch add command -label {Delete...} \
5243                -command do_delete_branch \
5244                -font font_ui
5245        lappend disable_on_lock [list .mbar.branch entryconf \
5246                [.mbar.branch index last] -state]
5247
5248        .mbar.branch add command -label {Reset...} \
5249                -command do_reset_hard \
5250                -font font_ui
5251        lappend disable_on_lock [list .mbar.branch entryconf \
5252                [.mbar.branch index last] -state]
5253}
5254
5255# -- Commit Menu
5256#
5257if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5258        menu .mbar.commit
5259
5260        .mbar.commit add radiobutton \
5261                -label {New Commit} \
5262                -command do_select_commit_type \
5263                -variable selected_commit_type \
5264                -value new \
5265                -font font_ui
5266        lappend disable_on_lock \
5267                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5268
5269        .mbar.commit add radiobutton \
5270                -label {Amend Last Commit} \
5271                -command do_select_commit_type \
5272                -variable selected_commit_type \
5273                -value amend \
5274                -font font_ui
5275        lappend disable_on_lock \
5276                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5277
5278        .mbar.commit add separator
5279
5280        .mbar.commit add command -label Rescan \
5281                -command do_rescan \
5282                -accelerator F5 \
5283                -font font_ui
5284        lappend disable_on_lock \
5285                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5286
5287        .mbar.commit add command -label {Add To Commit} \
5288                -command do_add_selection \
5289                -font font_ui
5290        lappend disable_on_lock \
5291                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5292
5293        .mbar.commit add command -label {Add Existing To Commit} \
5294                -command do_add_all \
5295                -accelerator $M1T-I \
5296                -font font_ui
5297        lappend disable_on_lock \
5298                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5299
5300        .mbar.commit add command -label {Unstage From Commit} \
5301                -command do_unstage_selection \
5302                -font font_ui
5303        lappend disable_on_lock \
5304                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5305
5306        .mbar.commit add command -label {Revert Changes} \
5307                -command do_revert_selection \
5308                -font font_ui
5309        lappend disable_on_lock \
5310                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5311
5312        .mbar.commit add separator
5313
5314        .mbar.commit add command -label {Sign Off} \
5315                -command do_signoff \
5316                -accelerator $M1T-S \
5317                -font font_ui
5318
5319        .mbar.commit add command -label Commit \
5320                -command do_commit \
5321                -accelerator $M1T-Return \
5322                -font font_ui
5323        lappend disable_on_lock \
5324                [list .mbar.commit entryconf [.mbar.commit index last] -state]
5325}
5326
5327# -- Merge Menu
5328#
5329if {[is_enabled branch]} {
5330        menu .mbar.merge
5331        .mbar.merge add command -label {Local Merge...} \
5332                -command do_local_merge \
5333                -font font_ui
5334        lappend disable_on_lock \
5335                [list .mbar.merge entryconf [.mbar.merge index last] -state]
5336        .mbar.merge add command -label {Abort Merge...} \
5337                -command do_reset_hard \
5338                -font font_ui
5339        lappend disable_on_lock \
5340                [list .mbar.merge entryconf [.mbar.merge index last] -state]
5341
5342}
5343
5344# -- Transport Menu
5345#
5346if {[is_enabled transport]} {
5347        menu .mbar.fetch
5348
5349        menu .mbar.push
5350        .mbar.push add command -label {Push...} \
5351                -command do_push_anywhere \
5352                -font font_ui
5353}
5354
5355if {[is_MacOSX]} {
5356        # -- Apple Menu (Mac OS X only)
5357        #
5358        .mbar add cascade -label Apple -menu .mbar.apple
5359        menu .mbar.apple
5360
5361        .mbar.apple add command -label "About [appname]" \
5362                -command do_about \
5363                -font font_ui
5364        .mbar.apple add command -label "Options..." \
5365                -command do_options \
5366                -font font_ui
5367} else {
5368        # -- Edit Menu
5369        #
5370        .mbar.edit add separator
5371        .mbar.edit add command -label {Options...} \
5372                -command do_options \
5373                -font font_ui
5374
5375        # -- Tools Menu
5376        #
5377        if {[file exists /usr/local/miga/lib/gui-miga]
5378                && [file exists .pvcsrc]} {
5379        proc do_miga {} {
5380                global ui_status_value
5381                if {![lock_index update]} return
5382                set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5383                set miga_fd [open "|$cmd" r]
5384                fconfigure $miga_fd -blocking 0
5385                fileevent $miga_fd readable [list miga_done $miga_fd]
5386                set ui_status_value {Running miga...}
5387        }
5388        proc miga_done {fd} {
5389                read $fd 512
5390                if {[eof $fd]} {
5391                        close $fd
5392                        unlock_index
5393                        rescan [list set ui_status_value {Ready.}]
5394                }
5395        }
5396        .mbar add cascade -label Tools -menu .mbar.tools
5397        menu .mbar.tools
5398        .mbar.tools add command -label "Migrate" \
5399                -command do_miga \
5400                -font font_ui
5401        lappend disable_on_lock \
5402                [list .mbar.tools entryconf [.mbar.tools index last] -state]
5403        }
5404}
5405
5406# -- Help Menu
5407#
5408.mbar add cascade -label Help -menu .mbar.help -font font_ui
5409menu .mbar.help
5410
5411if {![is_MacOSX]} {
5412        .mbar.help add command -label "About [appname]" \
5413                -command do_about \
5414                -font font_ui
5415}
5416
5417set browser {}
5418catch {set browser $repo_config(instaweb.browser)}
5419set doc_path [file dirname [gitexec]]
5420set doc_path [file join $doc_path Documentation index.html]
5421
5422if {[is_Cygwin]} {
5423        set doc_path [exec cygpath --mixed $doc_path]
5424}
5425
5426if {$browser eq {}} {
5427        if {[is_MacOSX]} {
5428                set browser open
5429        } elseif {[is_Cygwin]} {
5430                set program_files [file dirname [exec cygpath --windir]]
5431                set program_files [file join $program_files {Program Files}]
5432                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5433                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5434                if {[file exists $firefox]} {
5435                        set browser $firefox
5436                } elseif {[file exists $ie]} {
5437                        set browser $ie
5438                }
5439                unset program_files firefox ie
5440        }
5441}
5442
5443if {[file isfile $doc_path]} {
5444        set doc_url "file:$doc_path"
5445} else {
5446        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5447}
5448
5449if {$browser ne {}} {
5450        .mbar.help add command -label {Online Documentation} \
5451                -command [list exec $browser $doc_url &] \
5452                -font font_ui
5453}
5454unset browser doc_path doc_url
5455
5456# -- Standard bindings
5457#
5458bind .   <Destroy> do_quit
5459bind all <$M1B-Key-q> do_quit
5460bind all <$M1B-Key-Q> do_quit
5461bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5462bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5463
5464# -- Not a normal commit type invocation?  Do that instead!
5465#
5466switch -- $subcommand {
5467browser {
5468        if {[llength $argv] != 1} {
5469                puts stderr "usage: $argv0 browser commit"
5470                exit 1
5471        }
5472        set current_branch [lindex $argv 0]
5473        new_browser $current_branch
5474        return
5475}
5476blame {
5477        if {[llength $argv] != 2} {
5478                puts stderr "usage: $argv0 blame commit path"
5479                exit 1
5480        }
5481        set current_branch [lindex $argv 0]
5482        show_blame $current_branch [lindex $argv 1]
5483        return
5484}
5485citool -
5486gui {
5487        if {[llength $argv] != 0} {
5488                puts -nonewline stderr "usage: $argv0"
5489                if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5490                        puts -nonewline stderr " $subcommand"
5491                }
5492                puts stderr {}
5493                exit 1
5494        }
5495        # fall through to setup UI for commits
5496}
5497default {
5498        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5499        exit 1
5500}
5501}
5502
5503# -- Branch Control
5504#
5505frame .branch \
5506        -borderwidth 1 \
5507        -relief sunken
5508label .branch.l1 \
5509        -text {Current Branch:} \
5510        -anchor w \
5511        -justify left \
5512        -font font_ui
5513label .branch.cb \
5514        -textvariable current_branch \
5515        -anchor w \
5516        -justify left \
5517        -font font_ui
5518pack .branch.l1 -side left
5519pack .branch.cb -side left -fill x
5520pack .branch -side top -fill x
5521
5522# -- Main Window Layout
5523#
5524panedwindow .vpane -orient vertical
5525panedwindow .vpane.files -orient horizontal
5526.vpane add .vpane.files -sticky nsew -height 100 -width 200
5527pack .vpane -anchor n -side top -fill both -expand 1
5528
5529# -- Index File List
5530#
5531frame .vpane.files.index -height 100 -width 200
5532label .vpane.files.index.title -text {Changes To Be Committed} \
5533        -background green \
5534        -font font_ui
5535text $ui_index -background white -borderwidth 0 \
5536        -width 20 -height 10 \
5537        -wrap none \
5538        -font font_ui \
5539        -cursor $cursor_ptr \
5540        -xscrollcommand {.vpane.files.index.sx set} \
5541        -yscrollcommand {.vpane.files.index.sy set} \
5542        -state disabled
5543scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5544scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5545pack .vpane.files.index.title -side top -fill x
5546pack .vpane.files.index.sx -side bottom -fill x
5547pack .vpane.files.index.sy -side right -fill y
5548pack $ui_index -side left -fill both -expand 1
5549.vpane.files add .vpane.files.index -sticky nsew
5550
5551# -- Working Directory File List
5552#
5553frame .vpane.files.workdir -height 100 -width 200
5554label .vpane.files.workdir.title -text {Changed But Not Updated} \
5555        -background red \
5556        -font font_ui
5557text $ui_workdir -background white -borderwidth 0 \
5558        -width 20 -height 10 \
5559        -wrap none \
5560        -font font_ui \
5561        -cursor $cursor_ptr \
5562        -xscrollcommand {.vpane.files.workdir.sx set} \
5563        -yscrollcommand {.vpane.files.workdir.sy set} \
5564        -state disabled
5565scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5566scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5567pack .vpane.files.workdir.title -side top -fill x
5568pack .vpane.files.workdir.sx -side bottom -fill x
5569pack .vpane.files.workdir.sy -side right -fill y
5570pack $ui_workdir -side left -fill both -expand 1
5571.vpane.files add .vpane.files.workdir -sticky nsew
5572
5573foreach i [list $ui_index $ui_workdir] {
5574        $i tag conf in_diff -font font_uibold
5575        $i tag conf in_sel \
5576                -background [$i cget -foreground] \
5577                -foreground [$i cget -background]
5578}
5579unset i
5580
5581# -- Diff and Commit Area
5582#
5583frame .vpane.lower -height 300 -width 400
5584frame .vpane.lower.commarea
5585frame .vpane.lower.diff -relief sunken -borderwidth 1
5586pack .vpane.lower.commarea -side top -fill x
5587pack .vpane.lower.diff -side bottom -fill both -expand 1
5588.vpane add .vpane.lower -sticky nsew
5589
5590# -- Commit Area Buttons
5591#
5592frame .vpane.lower.commarea.buttons
5593label .vpane.lower.commarea.buttons.l -text {} \
5594        -anchor w \
5595        -justify left \
5596        -font font_ui
5597pack .vpane.lower.commarea.buttons.l -side top -fill x
5598pack .vpane.lower.commarea.buttons -side left -fill y
5599
5600button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5601        -command do_rescan \
5602        -font font_ui
5603pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5604lappend disable_on_lock \
5605        {.vpane.lower.commarea.buttons.rescan conf -state}
5606
5607button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5608        -command do_add_all \
5609        -font font_ui
5610pack .vpane.lower.commarea.buttons.incall -side top -fill x
5611lappend disable_on_lock \
5612        {.vpane.lower.commarea.buttons.incall conf -state}
5613
5614button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5615        -command do_signoff \
5616        -font font_ui
5617pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5618
5619button .vpane.lower.commarea.buttons.commit -text {Commit} \
5620        -command do_commit \
5621        -font font_ui
5622pack .vpane.lower.commarea.buttons.commit -side top -fill x
5623lappend disable_on_lock \
5624        {.vpane.lower.commarea.buttons.commit conf -state}
5625
5626# -- Commit Message Buffer
5627#
5628frame .vpane.lower.commarea.buffer
5629frame .vpane.lower.commarea.buffer.header
5630set ui_comm .vpane.lower.commarea.buffer.t
5631set ui_coml .vpane.lower.commarea.buffer.header.l
5632radiobutton .vpane.lower.commarea.buffer.header.new \
5633        -text {New Commit} \
5634        -command do_select_commit_type \
5635        -variable selected_commit_type \
5636        -value new \
5637        -font font_ui
5638lappend disable_on_lock \
5639        [list .vpane.lower.commarea.buffer.header.new conf -state]
5640radiobutton .vpane.lower.commarea.buffer.header.amend \
5641        -text {Amend Last Commit} \
5642        -command do_select_commit_type \
5643        -variable selected_commit_type \
5644        -value amend \
5645        -font font_ui
5646lappend disable_on_lock \
5647        [list .vpane.lower.commarea.buffer.header.amend conf -state]
5648label $ui_coml \
5649        -anchor w \
5650        -justify left \
5651        -font font_ui
5652proc trace_commit_type {varname args} {
5653        global ui_coml commit_type
5654        switch -glob -- $commit_type {
5655        initial       {set txt {Initial Commit Message:}}
5656        amend         {set txt {Amended Commit Message:}}
5657        amend-initial {set txt {Amended Initial Commit Message:}}
5658        amend-merge   {set txt {Amended Merge Commit Message:}}
5659        merge         {set txt {Merge Commit Message:}}
5660        *             {set txt {Commit Message:}}
5661        }
5662        $ui_coml conf -text $txt
5663}
5664trace add variable commit_type write trace_commit_type
5665pack $ui_coml -side left -fill x
5666pack .vpane.lower.commarea.buffer.header.amend -side right
5667pack .vpane.lower.commarea.buffer.header.new -side right
5668
5669text $ui_comm -background white -borderwidth 1 \
5670        -undo true \
5671        -maxundo 20 \
5672        -autoseparators true \
5673        -relief sunken \
5674        -width 75 -height 9 -wrap none \
5675        -font font_diff \
5676        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5677scrollbar .vpane.lower.commarea.buffer.sby \
5678        -command [list $ui_comm yview]
5679pack .vpane.lower.commarea.buffer.header -side top -fill x
5680pack .vpane.lower.commarea.buffer.sby -side right -fill y
5681pack $ui_comm -side left -fill y
5682pack .vpane.lower.commarea.buffer -side left -fill y
5683
5684# -- Commit Message Buffer Context Menu
5685#
5686set ctxm .vpane.lower.commarea.buffer.ctxm
5687menu $ctxm -tearoff 0
5688$ctxm add command \
5689        -label {Cut} \
5690        -font font_ui \
5691        -command {tk_textCut $ui_comm}
5692$ctxm add command \
5693        -label {Copy} \
5694        -font font_ui \
5695        -command {tk_textCopy $ui_comm}
5696$ctxm add command \
5697        -label {Paste} \
5698        -font font_ui \
5699        -command {tk_textPaste $ui_comm}
5700$ctxm add command \
5701        -label {Delete} \
5702        -font font_ui \
5703        -command {$ui_comm delete sel.first sel.last}
5704$ctxm add separator
5705$ctxm add command \
5706        -label {Select All} \
5707        -font font_ui \
5708        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5709$ctxm add command \
5710        -label {Copy All} \
5711        -font font_ui \
5712        -command {
5713                $ui_comm tag add sel 0.0 end
5714                tk_textCopy $ui_comm
5715                $ui_comm tag remove sel 0.0 end
5716        }
5717$ctxm add separator
5718$ctxm add command \
5719        -label {Sign Off} \
5720        -font font_ui \
5721        -command do_signoff
5722bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5723
5724# -- Diff Header
5725#
5726proc trace_current_diff_path {varname args} {
5727        global current_diff_path diff_actions file_states
5728        if {$current_diff_path eq {}} {
5729                set s {}
5730                set f {}
5731                set p {}
5732                set o disabled
5733        } else {
5734                set p $current_diff_path
5735                set s [mapdesc [lindex $file_states($p) 0] $p]
5736                set f {File:}
5737                set p [escape_path $p]
5738                set o normal
5739        }
5740
5741        .vpane.lower.diff.header.status configure -text $s
5742        .vpane.lower.diff.header.file configure -text $f
5743        .vpane.lower.diff.header.path configure -text $p
5744        foreach w $diff_actions {
5745                uplevel #0 $w $o
5746        }
5747}
5748trace add variable current_diff_path write trace_current_diff_path
5749
5750frame .vpane.lower.diff.header -background orange
5751label .vpane.lower.diff.header.status \
5752        -background orange \
5753        -width $max_status_desc \
5754        -anchor w \
5755        -justify left \
5756        -font font_ui
5757label .vpane.lower.diff.header.file \
5758        -background orange \
5759        -anchor w \
5760        -justify left \
5761        -font font_ui
5762label .vpane.lower.diff.header.path \
5763        -background orange \
5764        -anchor w \
5765        -justify left \
5766        -font font_ui
5767pack .vpane.lower.diff.header.status -side left
5768pack .vpane.lower.diff.header.file -side left
5769pack .vpane.lower.diff.header.path -fill x
5770set ctxm .vpane.lower.diff.header.ctxm
5771menu $ctxm -tearoff 0
5772$ctxm add command \
5773        -label {Copy} \
5774        -font font_ui \
5775        -command {
5776                clipboard clear
5777                clipboard append \
5778                        -format STRING \
5779                        -type STRING \
5780                        -- $current_diff_path
5781        }
5782lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5783bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5784
5785# -- Diff Body
5786#
5787frame .vpane.lower.diff.body
5788set ui_diff .vpane.lower.diff.body.t
5789text $ui_diff -background white -borderwidth 0 \
5790        -width 80 -height 15 -wrap none \
5791        -font font_diff \
5792        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5793        -yscrollcommand {.vpane.lower.diff.body.sby set} \
5794        -state disabled
5795scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5796        -command [list $ui_diff xview]
5797scrollbar .vpane.lower.diff.body.sby -orient vertical \
5798        -command [list $ui_diff yview]
5799pack .vpane.lower.diff.body.sbx -side bottom -fill x
5800pack .vpane.lower.diff.body.sby -side right -fill y
5801pack $ui_diff -side left -fill both -expand 1
5802pack .vpane.lower.diff.header -side top -fill x
5803pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5804
5805$ui_diff tag conf d_cr -elide true
5806$ui_diff tag conf d_@ -foreground blue -font font_diffbold
5807$ui_diff tag conf d_+ -foreground {#00a000}
5808$ui_diff tag conf d_- -foreground red
5809
5810$ui_diff tag conf d_++ -foreground {#00a000}
5811$ui_diff tag conf d_-- -foreground red
5812$ui_diff tag conf d_+s \
5813        -foreground {#00a000} \
5814        -background {#e2effa}
5815$ui_diff tag conf d_-s \
5816        -foreground red \
5817        -background {#e2effa}
5818$ui_diff tag conf d_s+ \
5819        -foreground {#00a000} \
5820        -background ivory1
5821$ui_diff tag conf d_s- \
5822        -foreground red \
5823        -background ivory1
5824
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$ui_diff tag conf d>>>>>>> \
5832        -foreground orange \
5833        -font font_diffbold
5834
5835$ui_diff tag raise sel
5836
5837# -- Diff Body Context Menu
5838#
5839set ctxm .vpane.lower.diff.body.ctxm
5840menu $ctxm -tearoff 0
5841$ctxm add command \
5842        -label {Refresh} \
5843        -font font_ui \
5844        -command reshow_diff
5845lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5846$ctxm add command \
5847        -label {Copy} \
5848        -font font_ui \
5849        -command {tk_textCopy $ui_diff}
5850lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5851$ctxm add command \
5852        -label {Select All} \
5853        -font font_ui \
5854        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5855lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5856$ctxm add command \
5857        -label {Copy All} \
5858        -font font_ui \
5859        -command {
5860                $ui_diff tag add sel 0.0 end
5861                tk_textCopy $ui_diff
5862                $ui_diff tag remove sel 0.0 end
5863        }
5864lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5865$ctxm add separator
5866$ctxm add command \
5867        -label {Apply/Reverse Hunk} \
5868        -font font_ui \
5869        -command {apply_hunk $cursorX $cursorY}
5870set ui_diff_applyhunk [$ctxm index last]
5871lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5872$ctxm add separator
5873$ctxm add command \
5874        -label {Decrease Font Size} \
5875        -font font_ui \
5876        -command {incr_font_size font_diff -1}
5877lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5878$ctxm add command \
5879        -label {Increase Font Size} \
5880        -font font_ui \
5881        -command {incr_font_size font_diff 1}
5882lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5883$ctxm add separator
5884$ctxm add command \
5885        -label {Show Less Context} \
5886        -font font_ui \
5887        -command {if {$repo_config(gui.diffcontext) >= 2} {
5888                incr repo_config(gui.diffcontext) -1
5889                reshow_diff
5890        }}
5891lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5892$ctxm add command \
5893        -label {Show More Context} \
5894        -font font_ui \
5895        -command {
5896                incr repo_config(gui.diffcontext)
5897                reshow_diff
5898        }
5899lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5900$ctxm add separator
5901$ctxm add command -label {Options...} \
5902        -font font_ui \
5903        -command do_options
5904bind_button3 $ui_diff "
5905        set cursorX %x
5906        set cursorY %y
5907        if {\$ui_index eq \$current_diff_side} {
5908                $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5909        } else {
5910                $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5911        }
5912        tk_popup $ctxm %X %Y
5913"
5914unset ui_diff_applyhunk
5915
5916# -- Status Bar
5917#
5918label .status -textvariable ui_status_value \
5919        -anchor w \
5920        -justify left \
5921        -borderwidth 1 \
5922        -relief sunken \
5923        -font font_ui
5924pack .status -anchor w -side bottom -fill x
5925
5926# -- Load geometry
5927#
5928catch {
5929set gm $repo_config(gui.geometry)
5930wm geometry . [lindex $gm 0]
5931.vpane sash place 0 \
5932        [lindex [.vpane sash coord 0] 0] \
5933        [lindex $gm 1]
5934.vpane.files sash place 0 \
5935        [lindex $gm 2] \
5936        [lindex [.vpane.files sash coord 0] 1]
5937unset gm
5938}
5939
5940# -- Key Bindings
5941#
5942bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5943bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5944bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5945bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5946bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5947bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5948bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5949bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5950bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5951bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5952bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5953
5954bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5955bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5956bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5957bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5958bind $ui_diff <$M1B-Key-v> {break}
5959bind $ui_diff <$M1B-Key-V> {break}
5960bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5961bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5962bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5963bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5964bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5965bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5966bind $ui_diff <Button-1>   {focus %W}
5967
5968if {[is_enabled branch]} {
5969        bind . <$M1B-Key-n> do_create_branch
5970        bind . <$M1B-Key-N> do_create_branch
5971}
5972
5973bind all <Key-F5> do_rescan
5974bind all <$M1B-Key-r> do_rescan
5975bind all <$M1B-Key-R> do_rescan
5976bind .   <$M1B-Key-s> do_signoff
5977bind .   <$M1B-Key-S> do_signoff
5978bind .   <$M1B-Key-i> do_add_all
5979bind .   <$M1B-Key-I> do_add_all
5980bind .   <$M1B-Key-Return> do_commit
5981foreach i [list $ui_index $ui_workdir] {
5982        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5983        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5984        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5985}
5986unset i
5987
5988set file_lists($ui_index) [list]
5989set file_lists($ui_workdir) [list]
5990
5991wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
5992focus -force $ui_comm
5993
5994# -- Warn the user about environmental problems.  Cygwin's Tcl
5995#    does *not* pass its env array onto any processes it spawns.
5996#    This means that git processes get none of our environment.
5997#
5998if {[is_Cygwin]} {
5999        set ignored_env 0
6000        set suggest_user {}
6001        set msg "Possible environment issues exist.
6002
6003The following environment variables are probably
6004going to be ignored by any Git subprocess run
6005by [appname]:
6006
6007"
6008        foreach name [array names env] {
6009                switch -regexp -- $name {
6010                {^GIT_INDEX_FILE$} -
6011                {^GIT_OBJECT_DIRECTORY$} -
6012                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6013                {^GIT_DIFF_OPTS$} -
6014                {^GIT_EXTERNAL_DIFF$} -
6015                {^GIT_PAGER$} -
6016                {^GIT_TRACE$} -
6017                {^GIT_CONFIG$} -
6018                {^GIT_CONFIG_LOCAL$} -
6019                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6020                        append msg " - $name\n"
6021                        incr ignored_env
6022                }
6023                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6024                        append msg " - $name\n"
6025                        incr ignored_env
6026                        set suggest_user $name
6027                }
6028                }
6029        }
6030        if {$ignored_env > 0} {
6031                append msg "
6032This is due to a known issue with the
6033Tcl binary distributed by Cygwin."
6034
6035                if {$suggest_user ne {}} {
6036                        append msg "
6037
6038A good replacement for $suggest_user
6039is placing values for the user.name and
6040user.email settings into your personal
6041~/.gitconfig file.
6042"
6043                }
6044                warn_popup $msg
6045        }
6046        unset ignored_env msg suggest_user name
6047}
6048
6049# -- Only initialize complex UI if we are going to stay running.
6050#
6051if {[is_enabled transport]} {
6052        load_all_remotes
6053        load_all_heads
6054
6055        populate_branch_menu
6056        populate_fetch_menu
6057        populate_push_menu
6058}
6059
6060# -- Only suggest a gc run if we are going to stay running.
6061#
6062if {[is_enabled multicommit]} {
6063        set object_limit 2000
6064        if {[is_Windows]} {set object_limit 200}
6065        regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6066        if {$objects_current >= $object_limit} {
6067                if {[ask_popup \
6068                        "This repository currently has $objects_current loose objects.
6069
6070To maintain optimal performance it is strongly recommended that you compress the database when more than $object_limit loose objects exist.
6071
6072Compress the database now?"] eq yes} {
6073                        do_gc
6074                }
6075        }
6076        unset object_limit _junk objects_current
6077}
6078
6079lock_index begin-read
6080after 1 do_rescan