git-gui.shon commit Merge branch 'maint' (b2bd310)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3 if test "z$*" = zversion \
   4 || test "z$*" = z--version; \
   5 then \
   6        echo 'git-gui version @@GITGUI_VERSION@@'; \
   7        exit; \
   8 fi; \
   9 exec wish "$0" -- "$@"
  10
  11set appvers {@@GITGUI_VERSION@@}
  12set copyright {
  13Copyright © 2006, 2007 Shawn Pearce, et. al.
  14
  15This program is free software; you can redistribute it and/or modify
  16it under the terms of the GNU General Public License as published by
  17the Free Software Foundation; either version 2 of the License, or
  18(at your option) any later version.
  19
  20This program is distributed in the hope that it will be useful,
  21but WITHOUT ANY WARRANTY; without even the implied warranty of
  22MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  23GNU General Public License for more details.
  24
  25You should have received a copy of the GNU General Public License
  26along with this program; if not, write to the Free Software
  27Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  28
  29######################################################################
  30##
  31## Tcl/Tk sanity check
  32
  33if {[catch {package require Tcl 8.4} err]
  34 || [catch {package require Tk  8.4} err]
  35} {
  36        catch {wm withdraw .}
  37        tk_messageBox \
  38                -icon error \
  39                -type ok \
  40                -title "git-gui: fatal error" \
  41                -message $err
  42        exit 1
  43}
  44
  45rename send {} ; # What an evil concept...
  46
  47######################################################################
  48##
  49## locate our library
  50
  51set oguilib {@@GITGUI_LIBDIR@@}
  52set oguirel {@@GITGUI_RELATIVE@@}
  53if {$oguirel eq {1}} {
  54        set oguilib [file dirname [file dirname [file normalize $argv0]]]
  55        set oguilib [file join $oguilib share git-gui lib]
  56        set oguimsg [file join $oguilib msgs]
  57} elseif {[string match @@* $oguirel]} {
  58        set oguilib [file join [file dirname [file normalize $argv0]] lib]
  59        set oguimsg [file join [file dirname [file normalize $argv0]] po]
  60} else {
  61        set oguimsg [file join $oguilib msgs]
  62}
  63unset oguirel
  64
  65######################################################################
  66##
  67## enable verbose loading?
  68
  69if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  70        unset _verbose
  71        rename auto_load real__auto_load
  72        proc auto_load {name args} {
  73                puts stderr "auto_load $name"
  74                return [uplevel 1 real__auto_load $name $args]
  75        }
  76        rename source real__source
  77        proc source {name} {
  78                puts stderr "source    $name"
  79                uplevel 1 real__source $name
  80        }
  81}
  82
  83######################################################################
  84##
  85## Internationalization (i18n) through msgcat and gettext. See
  86## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  87
  88package require msgcat
  89namespace import ::msgcat::mc
  90::msgcat::mcload $oguimsg
  91unset oguimsg
  92
  93######################################################################
  94##
  95## read only globals
  96
  97set _appname [lindex [file split $argv0] end]
  98set _gitdir {}
  99set _gitexec {}
 100set _reponame {}
 101set _iscygwin {}
 102set _search_path {}
 103
 104proc appname {} {
 105        global _appname
 106        return $_appname
 107}
 108
 109proc gitdir {args} {
 110        global _gitdir
 111        if {$args eq {}} {
 112                return $_gitdir
 113        }
 114        return [eval [list file join $_gitdir] $args]
 115}
 116
 117proc gitexec {args} {
 118        global _gitexec
 119        if {$_gitexec eq {}} {
 120                if {[catch {set _gitexec [git --exec-path]} err]} {
 121                        error "Git not installed?\n\n$err"
 122                }
 123                if {[is_Cygwin]} {
 124                        set _gitexec [exec cygpath \
 125                                --windows \
 126                                --absolute \
 127                                $_gitexec]
 128                } else {
 129                        set _gitexec [file normalize $_gitexec]
 130                }
 131        }
 132        if {$args eq {}} {
 133                return $_gitexec
 134        }
 135        return [eval [list file join $_gitexec] $args]
 136}
 137
 138proc reponame {} {
 139        return $::_reponame
 140}
 141
 142proc is_MacOSX {} {
 143        if {[tk windowingsystem] eq {aqua}} {
 144                return 1
 145        }
 146        return 0
 147}
 148
 149proc is_Windows {} {
 150        if {$::tcl_platform(platform) eq {windows}} {
 151                return 1
 152        }
 153        return 0
 154}
 155
 156proc is_Cygwin {} {
 157        global _iscygwin
 158        if {$_iscygwin eq {}} {
 159                if {$::tcl_platform(platform) eq {windows}} {
 160                        if {[catch {set p [exec cygpath --windir]} err]} {
 161                                set _iscygwin 0
 162                        } else {
 163                                set _iscygwin 1
 164                        }
 165                } else {
 166                        set _iscygwin 0
 167                }
 168        }
 169        return $_iscygwin
 170}
 171
 172proc is_enabled {option} {
 173        global enabled_options
 174        if {[catch {set on $enabled_options($option)}]} {return 0}
 175        return $on
 176}
 177
 178proc enable_option {option} {
 179        global enabled_options
 180        set enabled_options($option) 1
 181}
 182
 183proc disable_option {option} {
 184        global enabled_options
 185        set enabled_options($option) 0
 186}
 187
 188######################################################################
 189##
 190## config
 191
 192proc is_many_config {name} {
 193        switch -glob -- $name {
 194        remote.*.fetch -
 195        remote.*.push
 196                {return 1}
 197        *
 198                {return 0}
 199        }
 200}
 201
 202proc is_config_true {name} {
 203        global repo_config
 204        if {[catch {set v $repo_config($name)}]} {
 205                return 0
 206        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 207                return 1
 208        } else {
 209                return 0
 210        }
 211}
 212
 213proc get_config {name} {
 214        global repo_config
 215        if {[catch {set v $repo_config($name)}]} {
 216                return {}
 217        } else {
 218                return $v
 219        }
 220}
 221
 222proc load_config {include_global} {
 223        global repo_config global_config default_config
 224
 225        array unset global_config
 226        if {$include_global} {
 227                catch {
 228                        set fd_rc [git_read config --global --list]
 229                        while {[gets $fd_rc line] >= 0} {
 230                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 231                                        if {[is_many_config $name]} {
 232                                                lappend global_config($name) $value
 233                                        } else {
 234                                                set global_config($name) $value
 235                                        }
 236                                }
 237                        }
 238                        close $fd_rc
 239                }
 240        }
 241
 242        array unset repo_config
 243        catch {
 244                set fd_rc [git_read config --list]
 245                while {[gets $fd_rc line] >= 0} {
 246                        if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 247                                if {[is_many_config $name]} {
 248                                        lappend repo_config($name) $value
 249                                } else {
 250                                        set repo_config($name) $value
 251                                }
 252                        }
 253                }
 254                close $fd_rc
 255        }
 256
 257        foreach name [array names default_config] {
 258                if {[catch {set v $global_config($name)}]} {
 259                        set global_config($name) $default_config($name)
 260                }
 261                if {[catch {set v $repo_config($name)}]} {
 262                        set repo_config($name) $default_config($name)
 263                }
 264        }
 265}
 266
 267######################################################################
 268##
 269## handy utils
 270
 271proc _git_cmd {name} {
 272        global _git_cmd_path
 273
 274        if {[catch {set v $_git_cmd_path($name)}]} {
 275                switch -- $name {
 276                  version   -
 277                --version   -
 278                --exec-path { return [list $::_git $name] }
 279                }
 280
 281                set p [gitexec git-$name$::_search_exe]
 282                if {[file exists $p]} {
 283                        set v [list $p]
 284                } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 285                        # Try to determine what sort of magic will make
 286                        # git-$name go and do its thing, because native
 287                        # Tcl on Windows doesn't know it.
 288                        #
 289                        set p [gitexec git-$name]
 290                        set f [open $p r]
 291                        set s [gets $f]
 292                        close $f
 293
 294                        switch -glob -- [lindex $s 0] {
 295                        #!*sh     { set i sh     }
 296                        #!*perl   { set i perl   }
 297                        #!*python { set i python }
 298                        default   { error "git-$name is not supported: $s" }
 299                        }
 300
 301                        upvar #0 _$i interp
 302                        if {![info exists interp]} {
 303                                set interp [_which $i]
 304                        }
 305                        if {$interp eq {}} {
 306                                error "git-$name requires $i (not in PATH)"
 307                        }
 308                        set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 309                } else {
 310                        # Assume it is builtin to git somehow and we
 311                        # aren't actually able to see a file for it.
 312                        #
 313                        set v [list $::_git $name]
 314                }
 315                set _git_cmd_path($name) $v
 316        }
 317        return $v
 318}
 319
 320proc _which {what} {
 321        global env _search_exe _search_path
 322
 323        if {$_search_path eq {}} {
 324                if {[is_Cygwin]} {
 325                        set _search_path [split [exec cygpath \
 326                                --windows \
 327                                --path \
 328                                --absolute \
 329                                $env(PATH)] {;}]
 330                        set _search_exe .exe
 331                } elseif {[is_Windows]} {
 332                        set _search_path [split $env(PATH) {;}]
 333                        set _search_exe .exe
 334                } else {
 335                        set _search_path [split $env(PATH) :]
 336                        set _search_exe {}
 337                }
 338        }
 339
 340        foreach p $_search_path {
 341                set p [file join $p $what$_search_exe]
 342                if {[file exists $p]} {
 343                        return [file normalize $p]
 344                }
 345        }
 346        return {}
 347}
 348
 349proc _lappend_nice {cmd_var} {
 350        global _nice
 351        upvar $cmd_var cmd
 352
 353        if {![info exists _nice]} {
 354                set _nice [_which nice]
 355        }
 356        if {$_nice ne {}} {
 357                lappend cmd $_nice
 358        }
 359}
 360
 361proc git {args} {
 362        set opt [list exec]
 363
 364        while {1} {
 365                switch -- [lindex $args 0] {
 366                --nice {
 367                        _lappend_nice opt
 368                }
 369
 370                default {
 371                        break
 372                }
 373
 374                }
 375
 376                set args [lrange $args 1 end]
 377        }
 378
 379        set cmdp [_git_cmd [lindex $args 0]]
 380        set args [lrange $args 1 end]
 381
 382        return [eval $opt $cmdp $args]
 383}
 384
 385proc _open_stdout_stderr {cmd} {
 386        if {[catch {
 387                        set fd [open $cmd r]
 388                } err]} {
 389                if {   [lindex $cmd end] eq {2>@1}
 390                    && $err eq {can not find channel named "1"}
 391                        } {
 392                        # Older versions of Tcl 8.4 don't have this 2>@1 IO
 393                        # redirect operator.  Fallback to |& cat for those.
 394                        # The command was not actually started, so its safe
 395                        # to try to start it a second time.
 396                        #
 397                        set fd [open [concat \
 398                                [lrange $cmd 0 end-1] \
 399                                [list |& cat] \
 400                                ] r]
 401                } else {
 402                        error $err
 403                }
 404        }
 405        fconfigure $fd -eofchar {}
 406        return $fd
 407}
 408
 409proc git_read {args} {
 410        set opt [list |]
 411
 412        while {1} {
 413                switch -- [lindex $args 0] {
 414                --nice {
 415                        _lappend_nice opt
 416                }
 417
 418                --stderr {
 419                        lappend args 2>@1
 420                }
 421
 422                default {
 423                        break
 424                }
 425
 426                }
 427
 428                set args [lrange $args 1 end]
 429        }
 430
 431        set cmdp [_git_cmd [lindex $args 0]]
 432        set args [lrange $args 1 end]
 433
 434        return [_open_stdout_stderr [concat $opt $cmdp $args]]
 435}
 436
 437proc git_write {args} {
 438        set opt [list |]
 439
 440        while {1} {
 441                switch -- [lindex $args 0] {
 442                --nice {
 443                        _lappend_nice opt
 444                }
 445
 446                default {
 447                        break
 448                }
 449
 450                }
 451
 452                set args [lrange $args 1 end]
 453        }
 454
 455        set cmdp [_git_cmd [lindex $args 0]]
 456        set args [lrange $args 1 end]
 457
 458        return [open [concat $opt $cmdp $args] w]
 459}
 460
 461proc sq {value} {
 462        regsub -all ' $value "'\\''" value
 463        return "'$value'"
 464}
 465
 466proc load_current_branch {} {
 467        global current_branch is_detached
 468
 469        set fd [open [gitdir HEAD] r]
 470        if {[gets $fd ref] < 1} {
 471                set ref {}
 472        }
 473        close $fd
 474
 475        set pfx {ref: refs/heads/}
 476        set len [string length $pfx]
 477        if {[string equal -length $len $pfx $ref]} {
 478                # We're on a branch.  It might not exist.  But
 479                # HEAD looks good enough to be a branch.
 480                #
 481                set current_branch [string range $ref $len end]
 482                set is_detached 0
 483        } else {
 484                # Assume this is a detached head.
 485                #
 486                set current_branch HEAD
 487                set is_detached 1
 488        }
 489}
 490
 491auto_load tk_optionMenu
 492rename tk_optionMenu real__tkOptionMenu
 493proc tk_optionMenu {w varName args} {
 494        set m [eval real__tkOptionMenu $w $varName $args]
 495        $m configure -font font_ui
 496        $w configure -font font_ui
 497        return $m
 498}
 499
 500######################################################################
 501##
 502## find git
 503
 504set _git  [_which git]
 505if {$_git eq {}} {
 506        catch {wm withdraw .}
 507        error_popup [mc "Cannot find git in PATH."]
 508        exit 1
 509}
 510
 511######################################################################
 512##
 513## version check
 514
 515if {[catch {set _git_version [git --version]} err]} {
 516        catch {wm withdraw .}
 517        tk_messageBox \
 518                -icon error \
 519                -type ok \
 520                -title "git-gui: fatal error" \
 521                -message "Cannot determine Git version:
 522
 523$err
 524
 525[appname] requires Git 1.5.0 or later."
 526        exit 1
 527}
 528if {![regsub {^git version } $_git_version {} _git_version]} {
 529        catch {wm withdraw .}
 530        tk_messageBox \
 531                -icon error \
 532                -type ok \
 533                -title "git-gui: fatal error" \
 534                -message [append [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 535        exit 1
 536}
 537
 538set _real_git_version $_git_version
 539regsub -- {-dirty$} $_git_version {} _git_version
 540regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 541regsub {\.rc[0-9]+$} $_git_version {} _git_version
 542regsub {\.GIT$} $_git_version {} _git_version
 543
 544if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 545        catch {wm withdraw .}
 546        if {[tk_messageBox \
 547                -icon warning \
 548                -type yesno \
 549                -default no \
 550                -title "[appname]: warning" \
 551                 -message [mc "Git version cannot be determined.
 552
 553%s claims it is version '%s'.
 554
 555%s requires at least Git 1.5.0 or later.
 556
 557Assume '%s' is version 1.5.0?
 558" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 559                set _git_version 1.5.0
 560        } else {
 561                exit 1
 562        }
 563}
 564unset _real_git_version
 565
 566proc git-version {args} {
 567        global _git_version
 568
 569        switch [llength $args] {
 570        0 {
 571                return $_git_version
 572        }
 573
 574        2 {
 575                set op [lindex $args 0]
 576                set vr [lindex $args 1]
 577                set cm [package vcompare $_git_version $vr]
 578                return [expr $cm $op 0]
 579        }
 580
 581        4 {
 582                set type [lindex $args 0]
 583                set name [lindex $args 1]
 584                set parm [lindex $args 2]
 585                set body [lindex $args 3]
 586
 587                if {($type ne {proc} && $type ne {method})} {
 588                        error "Invalid arguments to git-version"
 589                }
 590                if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 591                        error "Last arm of $type $name must be default"
 592                }
 593
 594                foreach {op vr cb} [lrange $body 0 end-2] {
 595                        if {[git-version $op $vr]} {
 596                                return [uplevel [list $type $name $parm $cb]]
 597                        }
 598                }
 599
 600                return [uplevel [list $type $name $parm [lindex $body end]]]
 601        }
 602
 603        default {
 604                error "git-version >= x"
 605        }
 606
 607        }
 608}
 609
 610if {[git-version < 1.5]} {
 611        catch {wm withdraw .}
 612        tk_messageBox \
 613                -icon error \
 614                -type ok \
 615                -title "git-gui: fatal error" \
 616                -message "[appname] requires Git 1.5.0 or later.
 617
 618You are using [git-version]:
 619
 620[git --version]"
 621        exit 1
 622}
 623
 624######################################################################
 625##
 626## configure our library
 627
 628set idx [file join $oguilib tclIndex]
 629if {[catch {set fd [open $idx r]} err]} {
 630        catch {wm withdraw .}
 631        tk_messageBox \
 632                -icon error \
 633                -type ok \
 634                -title "git-gui: fatal error" \
 635                -message $err
 636        exit 1
 637}
 638if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
 639        set idx [list]
 640        while {[gets $fd n] >= 0} {
 641                if {$n ne {} && ![string match #* $n]} {
 642                        lappend idx $n
 643                }
 644        }
 645} else {
 646        set idx {}
 647}
 648close $fd
 649
 650if {$idx ne {}} {
 651        set loaded [list]
 652        foreach p $idx {
 653                if {[lsearch -exact $loaded $p] >= 0} continue
 654                source [file join $oguilib $p]
 655                lappend loaded $p
 656        }
 657        unset loaded p
 658} else {
 659        set auto_path [concat [list $oguilib] $auto_path]
 660}
 661unset -nocomplain idx fd
 662
 663######################################################################
 664##
 665## feature option selection
 666
 667if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
 668        unset _junk
 669} else {
 670        set subcommand gui
 671}
 672if {$subcommand eq {gui.sh}} {
 673        set subcommand gui
 674}
 675if {$subcommand eq {gui} && [llength $argv] > 0} {
 676        set subcommand [lindex $argv 0]
 677        set argv [lrange $argv 1 end]
 678}
 679
 680enable_option multicommit
 681enable_option branch
 682enable_option transport
 683disable_option bare
 684
 685switch -- $subcommand {
 686browser -
 687blame {
 688        enable_option bare
 689
 690        disable_option multicommit
 691        disable_option branch
 692        disable_option transport
 693}
 694citool {
 695        enable_option singlecommit
 696
 697        disable_option multicommit
 698        disable_option branch
 699        disable_option transport
 700}
 701}
 702
 703######################################################################
 704##
 705## repository setup
 706
 707if {[catch {
 708                set _gitdir $env(GIT_DIR)
 709                set _prefix {}
 710                }]
 711        && [catch {
 712                set _gitdir [git rev-parse --git-dir]
 713                set _prefix [git rev-parse --show-prefix]
 714        } err]} {
 715        catch {wm withdraw .}
 716        error_popup [append [mc "Cannot find the git directory:"] "\n\n$err"]
 717        exit 1
 718}
 719if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 720        catch {set _gitdir [exec cygpath --unix $_gitdir]}
 721}
 722if {![file isdirectory $_gitdir]} {
 723        catch {wm withdraw .}
 724        error_popup [append [mc "Git directory not found:"] "\n\n$_gitdir"]
 725        exit 1
 726}
 727if {$_prefix ne {}} {
 728        regsub -all {[^/]+/} $_prefix ../ cdup
 729        if {[catch {cd $cdup} err]} {
 730                catch {wm withdraw .}
 731                error_popup "Cannot move to top of working directory:\n\n$err"
 732                exit 1
 733        }
 734        unset cdup
 735} elseif {![is_enabled bare]} {
 736        if {[lindex [file split $_gitdir] end] ne {.git}} {
 737                catch {wm withdraw .}
 738                error_popup [append [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
 739                exit 1
 740        }
 741        if {[catch {cd [file dirname $_gitdir]} err]} {
 742                catch {wm withdraw .}
 743                error_popup [append [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
 744                exit 1
 745        }
 746}
 747set _reponame [file split [file normalize $_gitdir]]
 748if {[lindex $_reponame end] eq {.git}} {
 749        set _reponame [lindex $_reponame end-1]
 750} else {
 751        set _reponame [lindex $_reponame end]
 752}
 753
 754######################################################################
 755##
 756## global init
 757
 758set current_diff_path {}
 759set current_diff_side {}
 760set diff_actions [list]
 761
 762set HEAD {}
 763set PARENT {}
 764set MERGE_HEAD [list]
 765set commit_type {}
 766set empty_tree {}
 767set current_branch {}
 768set is_detached 0
 769set current_diff_path {}
 770set is_3way_diff 0
 771set selected_commit_type new
 772
 773######################################################################
 774##
 775## task management
 776
 777set rescan_active 0
 778set diff_active 0
 779set last_clicked {}
 780
 781set disable_on_lock [list]
 782set index_lock_type none
 783
 784proc lock_index {type} {
 785        global index_lock_type disable_on_lock
 786
 787        if {$index_lock_type eq {none}} {
 788                set index_lock_type $type
 789                foreach w $disable_on_lock {
 790                        uplevel #0 $w disabled
 791                }
 792                return 1
 793        } elseif {$index_lock_type eq "begin-$type"} {
 794                set index_lock_type $type
 795                return 1
 796        }
 797        return 0
 798}
 799
 800proc unlock_index {} {
 801        global index_lock_type disable_on_lock
 802
 803        set index_lock_type none
 804        foreach w $disable_on_lock {
 805                uplevel #0 $w normal
 806        }
 807}
 808
 809######################################################################
 810##
 811## status
 812
 813proc repository_state {ctvar hdvar mhvar} {
 814        global current_branch
 815        upvar $ctvar ct $hdvar hd $mhvar mh
 816
 817        set mh [list]
 818
 819        load_current_branch
 820        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 821                set hd {}
 822                set ct initial
 823                return
 824        }
 825
 826        set merge_head [gitdir MERGE_HEAD]
 827        if {[file exists $merge_head]} {
 828                set ct merge
 829                set fd_mh [open $merge_head r]
 830                while {[gets $fd_mh line] >= 0} {
 831                        lappend mh $line
 832                }
 833                close $fd_mh
 834                return
 835        }
 836
 837        set ct normal
 838}
 839
 840proc PARENT {} {
 841        global PARENT empty_tree
 842
 843        set p [lindex $PARENT 0]
 844        if {$p ne {}} {
 845                return $p
 846        }
 847        if {$empty_tree eq {}} {
 848                set empty_tree [git mktree << {}]
 849        }
 850        return $empty_tree
 851}
 852
 853proc rescan {after {honor_trustmtime 1}} {
 854        global HEAD PARENT MERGE_HEAD commit_type
 855        global ui_index ui_workdir ui_comm
 856        global rescan_active file_states
 857        global repo_config
 858
 859        if {$rescan_active > 0 || ![lock_index read]} return
 860
 861        repository_state newType newHEAD newMERGE_HEAD
 862        if {[string match amend* $commit_type]
 863                && $newType eq {normal}
 864                && $newHEAD eq $HEAD} {
 865        } else {
 866                set HEAD $newHEAD
 867                set PARENT $newHEAD
 868                set MERGE_HEAD $newMERGE_HEAD
 869                set commit_type $newType
 870        }
 871
 872        array unset file_states
 873
 874        if {!$::GITGUI_BCK_exists &&
 875                (![$ui_comm edit modified]
 876                || [string trim [$ui_comm get 0.0 end]] eq {})} {
 877                if {[string match amend* $commit_type]} {
 878                } elseif {[load_message GITGUI_MSG]} {
 879                } elseif {[load_message MERGE_MSG]} {
 880                } elseif {[load_message SQUASH_MSG]} {
 881                }
 882                $ui_comm edit reset
 883                $ui_comm edit modified false
 884        }
 885
 886        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 887                rescan_stage2 {} $after
 888        } else {
 889                set rescan_active 1
 890                ui_status [mc "Refreshing file status..."]
 891                set fd_rf [git_read update-index \
 892                        -q \
 893                        --unmerged \
 894                        --ignore-missing \
 895                        --refresh \
 896                        ]
 897                fconfigure $fd_rf -blocking 0 -translation binary
 898                fileevent $fd_rf readable \
 899                        [list rescan_stage2 $fd_rf $after]
 900        }
 901}
 902
 903proc rescan_stage2 {fd after} {
 904        global rescan_active buf_rdi buf_rdf buf_rlo
 905
 906        if {$fd ne {}} {
 907                read $fd
 908                if {![eof $fd]} return
 909                close $fd
 910        }
 911
 912        set ls_others [list --exclude-per-directory=.gitignore]
 913        set info_exclude [gitdir info exclude]
 914        if {[file readable $info_exclude]} {
 915                lappend ls_others "--exclude-from=$info_exclude"
 916        }
 917        set user_exclude [get_config core.excludesfile]
 918        if {$user_exclude ne {} && [file readable $user_exclude]} {
 919                lappend ls_others "--exclude-from=$user_exclude"
 920        }
 921
 922        set buf_rdi {}
 923        set buf_rdf {}
 924        set buf_rlo {}
 925
 926        set rescan_active 3
 927        ui_status [mc "Scanning for modified files ..."]
 928        set fd_di [git_read diff-index --cached -z [PARENT]]
 929        set fd_df [git_read diff-files -z]
 930        set fd_lo [eval git_read ls-files --others -z $ls_others]
 931
 932        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 933        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 934        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 935        fileevent $fd_di readable [list read_diff_index $fd_di $after]
 936        fileevent $fd_df readable [list read_diff_files $fd_df $after]
 937        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 938}
 939
 940proc load_message {file} {
 941        global ui_comm
 942
 943        set f [gitdir $file]
 944        if {[file isfile $f]} {
 945                if {[catch {set fd [open $f r]}]} {
 946                        return 0
 947                }
 948                fconfigure $fd -eofchar {}
 949                set content [string trim [read $fd]]
 950                close $fd
 951                regsub -all -line {[ \r\t]+$} $content {} content
 952                $ui_comm delete 0.0 end
 953                $ui_comm insert end $content
 954                return 1
 955        }
 956        return 0
 957}
 958
 959proc read_diff_index {fd after} {
 960        global buf_rdi
 961
 962        append buf_rdi [read $fd]
 963        set c 0
 964        set n [string length $buf_rdi]
 965        while {$c < $n} {
 966                set z1 [string first "\0" $buf_rdi $c]
 967                if {$z1 == -1} break
 968                incr z1
 969                set z2 [string first "\0" $buf_rdi $z1]
 970                if {$z2 == -1} break
 971
 972                incr c
 973                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 974                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 975                merge_state \
 976                        [encoding convertfrom $p] \
 977                        [lindex $i 4]? \
 978                        [list [lindex $i 0] [lindex $i 2]] \
 979                        [list]
 980                set c $z2
 981                incr c
 982        }
 983        if {$c < $n} {
 984                set buf_rdi [string range $buf_rdi $c end]
 985        } else {
 986                set buf_rdi {}
 987        }
 988
 989        rescan_done $fd buf_rdi $after
 990}
 991
 992proc read_diff_files {fd after} {
 993        global buf_rdf
 994
 995        append buf_rdf [read $fd]
 996        set c 0
 997        set n [string length $buf_rdf]
 998        while {$c < $n} {
 999                set z1 [string first "\0" $buf_rdf $c]
1000                if {$z1 == -1} break
1001                incr z1
1002                set z2 [string first "\0" $buf_rdf $z1]
1003                if {$z2 == -1} break
1004
1005                incr c
1006                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1007                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1008                merge_state \
1009                        [encoding convertfrom $p] \
1010                        ?[lindex $i 4] \
1011                        [list] \
1012                        [list [lindex $i 0] [lindex $i 2]]
1013                set c $z2
1014                incr c
1015        }
1016        if {$c < $n} {
1017                set buf_rdf [string range $buf_rdf $c end]
1018        } else {
1019                set buf_rdf {}
1020        }
1021
1022        rescan_done $fd buf_rdf $after
1023}
1024
1025proc read_ls_others {fd after} {
1026        global buf_rlo
1027
1028        append buf_rlo [read $fd]
1029        set pck [split $buf_rlo "\0"]
1030        set buf_rlo [lindex $pck end]
1031        foreach p [lrange $pck 0 end-1] {
1032                merge_state [encoding convertfrom $p] ?O
1033        }
1034        rescan_done $fd buf_rlo $after
1035}
1036
1037proc rescan_done {fd buf after} {
1038        global rescan_active current_diff_path
1039        global file_states repo_config
1040        upvar $buf to_clear
1041
1042        if {![eof $fd]} return
1043        set to_clear {}
1044        close $fd
1045        if {[incr rescan_active -1] > 0} return
1046
1047        prune_selection
1048        unlock_index
1049        display_all_files
1050        if {$current_diff_path ne {}} reshow_diff
1051        uplevel #0 $after
1052}
1053
1054proc prune_selection {} {
1055        global file_states selected_paths
1056
1057        foreach path [array names selected_paths] {
1058                if {[catch {set still_here $file_states($path)}]} {
1059                        unset selected_paths($path)
1060                }
1061        }
1062}
1063
1064######################################################################
1065##
1066## ui helpers
1067
1068proc mapicon {w state path} {
1069        global all_icons
1070
1071        if {[catch {set r $all_icons($state$w)}]} {
1072                puts "error: no icon for $w state={$state} $path"
1073                return file_plain
1074        }
1075        return $r
1076}
1077
1078proc mapdesc {state path} {
1079        global all_descs
1080
1081        if {[catch {set r $all_descs($state)}]} {
1082                puts "error: no desc for state={$state} $path"
1083                return $state
1084        }
1085        return $r
1086}
1087
1088proc ui_status {msg} {
1089        $::main_status show $msg
1090}
1091
1092proc ui_ready {{test {}}} {
1093        $::main_status show [mc "Ready."] $test
1094}
1095
1096proc escape_path {path} {
1097        regsub -all {\\} $path "\\\\" path
1098        regsub -all "\n" $path "\\n" path
1099        return $path
1100}
1101
1102proc short_path {path} {
1103        return [escape_path [lindex [file split $path] end]]
1104}
1105
1106set next_icon_id 0
1107set null_sha1 [string repeat 0 40]
1108
1109proc merge_state {path new_state {head_info {}} {index_info {}}} {
1110        global file_states next_icon_id null_sha1
1111
1112        set s0 [string index $new_state 0]
1113        set s1 [string index $new_state 1]
1114
1115        if {[catch {set info $file_states($path)}]} {
1116                set state __
1117                set icon n[incr next_icon_id]
1118        } else {
1119                set state [lindex $info 0]
1120                set icon [lindex $info 1]
1121                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1122                if {$index_info eq {}} {set index_info [lindex $info 3]}
1123        }
1124
1125        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1126        elseif {$s0 eq {_}} {set s0 _}
1127
1128        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1129        elseif {$s1 eq {_}} {set s1 _}
1130
1131        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1132                set head_info [list 0 $null_sha1]
1133        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1134                && $head_info eq {}} {
1135                set head_info $index_info
1136        }
1137
1138        set file_states($path) [list $s0$s1 $icon \
1139                $head_info $index_info \
1140                ]
1141        return $state
1142}
1143
1144proc display_file_helper {w path icon_name old_m new_m} {
1145        global file_lists
1146
1147        if {$new_m eq {_}} {
1148                set lno [lsearch -sorted -exact $file_lists($w) $path]
1149                if {$lno >= 0} {
1150                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1151                        incr lno
1152                        $w conf -state normal
1153                        $w delete $lno.0 [expr {$lno + 1}].0
1154                        $w conf -state disabled
1155                }
1156        } elseif {$old_m eq {_} && $new_m ne {_}} {
1157                lappend file_lists($w) $path
1158                set file_lists($w) [lsort -unique $file_lists($w)]
1159                set lno [lsearch -sorted -exact $file_lists($w) $path]
1160                incr lno
1161                $w conf -state normal
1162                $w image create $lno.0 \
1163                        -align center -padx 5 -pady 1 \
1164                        -name $icon_name \
1165                        -image [mapicon $w $new_m $path]
1166                $w insert $lno.1 "[escape_path $path]\n"
1167                $w conf -state disabled
1168        } elseif {$old_m ne $new_m} {
1169                $w conf -state normal
1170                $w image conf $icon_name -image [mapicon $w $new_m $path]
1171                $w conf -state disabled
1172        }
1173}
1174
1175proc display_file {path state} {
1176        global file_states selected_paths
1177        global ui_index ui_workdir
1178
1179        set old_m [merge_state $path $state]
1180        set s $file_states($path)
1181        set new_m [lindex $s 0]
1182        set icon_name [lindex $s 1]
1183
1184        set o [string index $old_m 0]
1185        set n [string index $new_m 0]
1186        if {$o eq {U}} {
1187                set o _
1188        }
1189        if {$n eq {U}} {
1190                set n _
1191        }
1192        display_file_helper     $ui_index $path $icon_name $o $n
1193
1194        if {[string index $old_m 0] eq {U}} {
1195                set o U
1196        } else {
1197                set o [string index $old_m 1]
1198        }
1199        if {[string index $new_m 0] eq {U}} {
1200                set n U
1201        } else {
1202                set n [string index $new_m 1]
1203        }
1204        display_file_helper     $ui_workdir $path $icon_name $o $n
1205
1206        if {$new_m eq {__}} {
1207                unset file_states($path)
1208                catch {unset selected_paths($path)}
1209        }
1210}
1211
1212proc display_all_files_helper {w path icon_name m} {
1213        global file_lists
1214
1215        lappend file_lists($w) $path
1216        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1217        $w image create end \
1218                -align center -padx 5 -pady 1 \
1219                -name $icon_name \
1220                -image [mapicon $w $m $path]
1221        $w insert end "[escape_path $path]\n"
1222}
1223
1224proc display_all_files {} {
1225        global ui_index ui_workdir
1226        global file_states file_lists
1227        global last_clicked
1228
1229        $ui_index conf -state normal
1230        $ui_workdir conf -state normal
1231
1232        $ui_index delete 0.0 end
1233        $ui_workdir delete 0.0 end
1234        set last_clicked {}
1235
1236        set file_lists($ui_index) [list]
1237        set file_lists($ui_workdir) [list]
1238
1239        foreach path [lsort [array names file_states]] {
1240                set s $file_states($path)
1241                set m [lindex $s 0]
1242                set icon_name [lindex $s 1]
1243
1244                set s [string index $m 0]
1245                if {$s ne {U} && $s ne {_}} {
1246                        display_all_files_helper $ui_index $path \
1247                                $icon_name $s
1248                }
1249
1250                if {[string index $m 0] eq {U}} {
1251                        set s U
1252                } else {
1253                        set s [string index $m 1]
1254                }
1255                if {$s ne {_}} {
1256                        display_all_files_helper $ui_workdir $path \
1257                                $icon_name $s
1258                }
1259        }
1260
1261        $ui_index conf -state disabled
1262        $ui_workdir conf -state disabled
1263}
1264
1265######################################################################
1266##
1267## icons
1268
1269set filemask {
1270#define mask_width 14
1271#define mask_height 15
1272static unsigned char mask_bits[] = {
1273   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1274   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1275   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1276}
1277
1278image create bitmap file_plain -background white -foreground black -data {
1279#define plain_width 14
1280#define plain_height 15
1281static unsigned char plain_bits[] = {
1282   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1283   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1284   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1285} -maskdata $filemask
1286
1287image create bitmap file_mod -background white -foreground blue -data {
1288#define mod_width 14
1289#define mod_height 15
1290static unsigned char mod_bits[] = {
1291   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1292   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1293   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1294} -maskdata $filemask
1295
1296image create bitmap file_fulltick -background white -foreground "#007000" -data {
1297#define file_fulltick_width 14
1298#define file_fulltick_height 15
1299static unsigned char file_fulltick_bits[] = {
1300   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1301   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1302   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1303} -maskdata $filemask
1304
1305image create bitmap file_parttick -background white -foreground "#005050" -data {
1306#define parttick_width 14
1307#define parttick_height 15
1308static unsigned char parttick_bits[] = {
1309   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1310   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1311   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1312} -maskdata $filemask
1313
1314image create bitmap file_question -background white -foreground black -data {
1315#define file_question_width 14
1316#define file_question_height 15
1317static unsigned char file_question_bits[] = {
1318   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1319   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1320   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1321} -maskdata $filemask
1322
1323image create bitmap file_removed -background white -foreground red -data {
1324#define file_removed_width 14
1325#define file_removed_height 15
1326static unsigned char file_removed_bits[] = {
1327   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1328   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1329   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1330} -maskdata $filemask
1331
1332image create bitmap file_merge -background white -foreground blue -data {
1333#define file_merge_width 14
1334#define file_merge_height 15
1335static unsigned char file_merge_bits[] = {
1336   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1337   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1338   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1339} -maskdata $filemask
1340
1341set ui_index .vpane.files.index.list
1342set ui_workdir .vpane.files.workdir.list
1343
1344set all_icons(_$ui_index)   file_plain
1345set all_icons(A$ui_index)   file_fulltick
1346set all_icons(M$ui_index)   file_fulltick
1347set all_icons(D$ui_index)   file_removed
1348set all_icons(U$ui_index)   file_merge
1349
1350set all_icons(_$ui_workdir) file_plain
1351set all_icons(M$ui_workdir) file_mod
1352set all_icons(D$ui_workdir) file_question
1353set all_icons(U$ui_workdir) file_merge
1354set all_icons(O$ui_workdir) file_plain
1355
1356set max_status_desc 0
1357foreach i {
1358                {__ {mc "Unmodified"}}
1359
1360                {_M {mc "Modified, not staged"}}
1361                {M_ {mc "Staged for commit"}}
1362                {MM {mc "Portions staged for commit"}}
1363                {MD {mc "Staged for commit, missing"}}
1364
1365                {_O {mc "Untracked, not staged"}}
1366                {A_ {mc "Staged for commit"}}
1367                {AM {mc "Portions staged for commit"}}
1368                {AD {mc "Staged for commit, missing"}}
1369
1370                {_D {mc "Missing"}}
1371                {D_ {mc "Staged for removal"}}
1372                {DO {mc "Staged for removal, still present"}}
1373
1374                {U_ {mc "Requires merge resolution"}}
1375                {UU {mc "Requires merge resolution"}}
1376                {UM {mc "Requires merge resolution"}}
1377                {UD {mc "Requires merge resolution"}}
1378        } {
1379        set text [eval [lindex $i 1]]
1380        if {$max_status_desc < [string length $text]} {
1381                set max_status_desc [string length $text]
1382        }
1383        set all_descs([lindex $i 0]) $text
1384}
1385unset i
1386
1387######################################################################
1388##
1389## util
1390
1391proc bind_button3 {w cmd} {
1392        bind $w <Any-Button-3> $cmd
1393        if {[is_MacOSX]} {
1394                # Mac OS X sends Button-2 on right click through three-button mouse,
1395                # or through trackpad right-clicking (two-finger touch + click).
1396                bind $w <Any-Button-2> $cmd
1397                bind $w <Control-Button-1> $cmd
1398        }
1399}
1400
1401proc scrollbar2many {list mode args} {
1402        foreach w $list {eval $w $mode $args}
1403}
1404
1405proc many2scrollbar {list mode sb top bottom} {
1406        $sb set $top $bottom
1407        foreach w $list {$w $mode moveto $top}
1408}
1409
1410proc incr_font_size {font {amt 1}} {
1411        set sz [font configure $font -size]
1412        incr sz $amt
1413        font configure $font -size $sz
1414        font configure ${font}bold -size $sz
1415        font configure ${font}italic -size $sz
1416}
1417
1418######################################################################
1419##
1420## ui commands
1421
1422set starting_gitk_msg [mc "Starting gitk... please wait..."]
1423
1424proc do_gitk {revs} {
1425        # -- Always start gitk through whatever we were loaded with.  This
1426        #    lets us bypass using shell process on Windows systems.
1427        #
1428        set exe [file join [file dirname $::_git] gitk]
1429        set cmd [list [info nameofexecutable] $exe]
1430        if {! [file exists $exe]} {
1431                error_popup [mc "Unable to start gitk:\n\n%s does not exist" $exe]
1432        } else {
1433                eval exec $cmd $revs &
1434                ui_status $::starting_gitk_msg
1435                after 10000 {
1436                        ui_ready $starting_gitk_msg
1437                }
1438        }
1439}
1440
1441set is_quitting 0
1442
1443proc do_quit {} {
1444        global ui_comm is_quitting repo_config commit_type
1445        global GITGUI_BCK_exists GITGUI_BCK_i
1446
1447        if {$is_quitting} return
1448        set is_quitting 1
1449
1450        if {[winfo exists $ui_comm]} {
1451                # -- Stash our current commit buffer.
1452                #
1453                set save [gitdir GITGUI_MSG]
1454                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1455                        file rename -force [gitdir GITGUI_BCK] $save
1456                        set GITGUI_BCK_exists 0
1457                } else {
1458                        set msg [string trim [$ui_comm get 0.0 end]]
1459                        regsub -all -line {[ \r\t]+$} $msg {} msg
1460                        if {(![string match amend* $commit_type]
1461                                || [$ui_comm edit modified])
1462                                && $msg ne {}} {
1463                                catch {
1464                                        set fd [open $save w]
1465                                        puts -nonewline $fd $msg
1466                                        close $fd
1467                                }
1468                        } else {
1469                                catch {file delete $save}
1470                        }
1471                }
1472
1473                # -- Remove our editor backup, its not needed.
1474                #
1475                after cancel $GITGUI_BCK_i
1476                if {$GITGUI_BCK_exists} {
1477                        catch {file delete [gitdir GITGUI_BCK]}
1478                }
1479
1480                # -- Stash our current window geometry into this repository.
1481                #
1482                set cfg_geometry [list]
1483                lappend cfg_geometry [wm geometry .]
1484                lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1485                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1486                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1487                        set rc_geometry {}
1488                }
1489                if {$cfg_geometry ne $rc_geometry} {
1490                        catch {git config gui.geometry $cfg_geometry}
1491                }
1492        }
1493
1494        destroy .
1495}
1496
1497proc do_rescan {} {
1498        rescan ui_ready
1499}
1500
1501proc do_commit {} {
1502        commit_tree
1503}
1504
1505proc toggle_or_diff {w x y} {
1506        global file_states file_lists current_diff_path ui_index ui_workdir
1507        global last_clicked selected_paths
1508
1509        set pos [split [$w index @$x,$y] .]
1510        set lno [lindex $pos 0]
1511        set col [lindex $pos 1]
1512        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1513        if {$path eq {}} {
1514                set last_clicked {}
1515                return
1516        }
1517
1518        set last_clicked [list $w $lno]
1519        array unset selected_paths
1520        $ui_index tag remove in_sel 0.0 end
1521        $ui_workdir tag remove in_sel 0.0 end
1522
1523        if {$col == 0} {
1524                if {$current_diff_path eq $path} {
1525                        set after {reshow_diff;}
1526                } else {
1527                        set after {}
1528                }
1529                if {$w eq $ui_index} {
1530                        update_indexinfo \
1531                                "Unstaging [short_path $path] from commit" \
1532                                [list $path] \
1533                                [concat $after [list ui_ready]]
1534                } elseif {$w eq $ui_workdir} {
1535                        update_index \
1536                                "Adding [short_path $path]" \
1537                                [list $path] \
1538                                [concat $after [list ui_ready]]
1539                }
1540        } else {
1541                show_diff $path $w $lno
1542        }
1543}
1544
1545proc add_one_to_selection {w x y} {
1546        global file_lists last_clicked selected_paths
1547
1548        set lno [lindex [split [$w index @$x,$y] .] 0]
1549        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1550        if {$path eq {}} {
1551                set last_clicked {}
1552                return
1553        }
1554
1555        if {$last_clicked ne {}
1556                && [lindex $last_clicked 0] ne $w} {
1557                array unset selected_paths
1558                [lindex $last_clicked 0] tag remove in_sel 0.0 end
1559        }
1560
1561        set last_clicked [list $w $lno]
1562        if {[catch {set in_sel $selected_paths($path)}]} {
1563                set in_sel 0
1564        }
1565        if {$in_sel} {
1566                unset selected_paths($path)
1567                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1568        } else {
1569                set selected_paths($path) 1
1570                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1571        }
1572}
1573
1574proc add_range_to_selection {w x y} {
1575        global file_lists last_clicked selected_paths
1576
1577        if {[lindex $last_clicked 0] ne $w} {
1578                toggle_or_diff $w $x $y
1579                return
1580        }
1581
1582        set lno [lindex [split [$w index @$x,$y] .] 0]
1583        set lc [lindex $last_clicked 1]
1584        if {$lc < $lno} {
1585                set begin $lc
1586                set end $lno
1587        } else {
1588                set begin $lno
1589                set end $lc
1590        }
1591
1592        foreach path [lrange $file_lists($w) \
1593                [expr {$begin - 1}] \
1594                [expr {$end - 1}]] {
1595                set selected_paths($path) 1
1596        }
1597        $w tag add in_sel $begin.0 [expr {$end + 1}].0
1598}
1599
1600######################################################################
1601##
1602## config defaults
1603
1604set cursor_ptr arrow
1605font create font_diff -family Courier -size 10
1606font create font_ui
1607catch {
1608        label .dummy
1609        eval font configure font_ui [font actual [.dummy cget -font]]
1610        destroy .dummy
1611}
1612
1613font create font_uiitalic
1614font create font_uibold
1615font create font_diffbold
1616font create font_diffitalic
1617
1618foreach class {Button Checkbutton Entry Label
1619                Labelframe Listbox Menu Message
1620                Radiobutton Spinbox Text} {
1621        option add *$class.font font_ui
1622}
1623unset class
1624
1625if {[is_Windows] || [is_MacOSX]} {
1626        option add *Menu.tearOff 0
1627}
1628
1629if {[is_MacOSX]} {
1630        set M1B M1
1631        set M1T Cmd
1632} else {
1633        set M1B Control
1634        set M1T Ctrl
1635}
1636
1637proc apply_config {} {
1638        global repo_config font_descs
1639
1640        foreach option $font_descs {
1641                set name [lindex $option 0]
1642                set font [lindex $option 1]
1643                if {[catch {
1644                        foreach {cn cv} $repo_config(gui.$name) {
1645                                font configure $font $cn $cv
1646                        }
1647                        } err]} {
1648                        error_popup [append [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
1649                }
1650                foreach {cn cv} [font configure $font] {
1651                        font configure ${font}bold $cn $cv
1652                        font configure ${font}italic $cn $cv
1653                }
1654                font configure ${font}bold -weight bold
1655                font configure ${font}italic -slant italic
1656        }
1657}
1658
1659set default_config(merge.diffstat) true
1660set default_config(merge.summary) false
1661set default_config(merge.verbosity) 2
1662set default_config(user.name) {}
1663set default_config(user.email) {}
1664
1665set default_config(gui.matchtrackingbranch) false
1666set default_config(gui.pruneduringfetch) false
1667set default_config(gui.trustmtime) false
1668set default_config(gui.diffcontext) 5
1669set default_config(gui.newbranchtemplate) {}
1670set default_config(gui.fontui) [font configure font_ui]
1671set default_config(gui.fontdiff) [font configure font_diff]
1672set font_descs {
1673        {fontui   font_ui   {mc "Main Font"}}
1674        {fontdiff font_diff {mc "Diff/Console Font"}}
1675}
1676load_config 0
1677apply_config
1678
1679######################################################################
1680##
1681## ui construction
1682
1683set ui_comm {}
1684
1685# -- Menu Bar
1686#
1687menu .mbar -tearoff 0
1688.mbar add cascade -label [mc Repository] -menu .mbar.repository
1689.mbar add cascade -label [mc Edit] -menu .mbar.edit
1690if {[is_enabled branch]} {
1691        .mbar add cascade -label [mc Branch] -menu .mbar.branch
1692}
1693if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1694        .mbar add cascade -label [mc Commit] -menu .mbar.commit
1695}
1696if {[is_enabled transport]} {
1697        .mbar add cascade -label [mc Merge] -menu .mbar.merge
1698        .mbar add cascade -label [mc Fetch] -menu .mbar.fetch
1699        .mbar add cascade -label [mc Push] -menu .mbar.push
1700}
1701. configure -menu .mbar
1702
1703# -- Repository Menu
1704#
1705menu .mbar.repository
1706
1707.mbar.repository add command \
1708        -label [mc "Browse Current Branch's Files"] \
1709        -command {browser::new $current_branch}
1710set ui_browse_current [.mbar.repository index last]
1711.mbar.repository add command \
1712        -label [mc "Browse Branch Files..."] \
1713        -command browser_open::dialog
1714.mbar.repository add separator
1715
1716.mbar.repository add command \
1717        -label [mc "Visualize Current Branch's History"] \
1718        -command {do_gitk $current_branch}
1719set ui_visualize_current [.mbar.repository index last]
1720.mbar.repository add command \
1721        -label [mc "Visualize All Branch History"] \
1722        -command {do_gitk --all}
1723.mbar.repository add separator
1724
1725proc current_branch_write {args} {
1726        global current_branch
1727        .mbar.repository entryconf $::ui_browse_current \
1728                -label [mc "Browse %s's Files" $current_branch]
1729        .mbar.repository entryconf $::ui_visualize_current \
1730                -label [mc "Visualize %s's History" $current_branch]
1731}
1732trace add variable current_branch write current_branch_write
1733
1734if {[is_enabled multicommit]} {
1735        .mbar.repository add command -label [mc "Database Statistics"] \
1736                -command do_stats
1737
1738        .mbar.repository add command -label [mc "Compress Database"] \
1739                -command do_gc
1740
1741        .mbar.repository add command -label [mc "Verify Database"] \
1742                -command do_fsck_objects
1743
1744        .mbar.repository add separator
1745
1746        if {[is_Cygwin]} {
1747                .mbar.repository add command \
1748                        -label [mc "Create Desktop Icon"] \
1749                        -command do_cygwin_shortcut
1750        } elseif {[is_Windows]} {
1751                .mbar.repository add command \
1752                        -label [mc "Create Desktop Icon"] \
1753                        -command do_windows_shortcut
1754        } elseif {[is_MacOSX]} {
1755                .mbar.repository add command \
1756                        -label [mc "Create Desktop Icon"] \
1757                        -command do_macosx_app
1758        }
1759}
1760
1761.mbar.repository add command -label [mc Quit] \
1762        -command do_quit \
1763        -accelerator $M1T-Q
1764
1765# -- Edit Menu
1766#
1767menu .mbar.edit
1768.mbar.edit add command -label [mc Undo] \
1769        -command {catch {[focus] edit undo}} \
1770        -accelerator $M1T-Z
1771.mbar.edit add command -label [mc Redo] \
1772        -command {catch {[focus] edit redo}} \
1773        -accelerator $M1T-Y
1774.mbar.edit add separator
1775.mbar.edit add command -label [mc Cut] \
1776        -command {catch {tk_textCut [focus]}} \
1777        -accelerator $M1T-X
1778.mbar.edit add command -label [mc Copy] \
1779        -command {catch {tk_textCopy [focus]}} \
1780        -accelerator $M1T-C
1781.mbar.edit add command -label [mc Paste] \
1782        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1783        -accelerator $M1T-V
1784.mbar.edit add command -label [mc Delete] \
1785        -command {catch {[focus] delete sel.first sel.last}} \
1786        -accelerator Del
1787.mbar.edit add separator
1788.mbar.edit add command -label [mc "Select All"] \
1789        -command {catch {[focus] tag add sel 0.0 end}} \
1790        -accelerator $M1T-A
1791
1792# -- Branch Menu
1793#
1794if {[is_enabled branch]} {
1795        menu .mbar.branch
1796
1797        .mbar.branch add command -label [mc "Create..."] \
1798                -command branch_create::dialog \
1799                -accelerator $M1T-N
1800        lappend disable_on_lock [list .mbar.branch entryconf \
1801                [.mbar.branch index last] -state]
1802
1803        .mbar.branch add command -label [mc "Checkout..."] \
1804                -command branch_checkout::dialog \
1805                -accelerator $M1T-O
1806        lappend disable_on_lock [list .mbar.branch entryconf \
1807                [.mbar.branch index last] -state]
1808
1809        .mbar.branch add command -label [mc "Rename..."] \
1810                -command branch_rename::dialog
1811        lappend disable_on_lock [list .mbar.branch entryconf \
1812                [.mbar.branch index last] -state]
1813
1814        .mbar.branch add command -label [mc "Delete..."] \
1815                -command branch_delete::dialog
1816        lappend disable_on_lock [list .mbar.branch entryconf \
1817                [.mbar.branch index last] -state]
1818
1819        .mbar.branch add command -label [mc "Reset..."] \
1820                -command merge::reset_hard
1821        lappend disable_on_lock [list .mbar.branch entryconf \
1822                [.mbar.branch index last] -state]
1823}
1824
1825# -- Commit Menu
1826#
1827if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1828        menu .mbar.commit
1829
1830        .mbar.commit add radiobutton \
1831                -label [mc "New Commit"] \
1832                -command do_select_commit_type \
1833                -variable selected_commit_type \
1834                -value new
1835        lappend disable_on_lock \
1836                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1837
1838        .mbar.commit add radiobutton \
1839                -label [mc "Amend Last Commit"] \
1840                -command do_select_commit_type \
1841                -variable selected_commit_type \
1842                -value amend
1843        lappend disable_on_lock \
1844                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1845
1846        .mbar.commit add separator
1847
1848        .mbar.commit add command -label [mc Rescan] \
1849                -command do_rescan \
1850                -accelerator F5
1851        lappend disable_on_lock \
1852                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1853
1854        .mbar.commit add command -label [mc "Stage To Commit"] \
1855                -command do_add_selection
1856        lappend disable_on_lock \
1857                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1858
1859        .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1860                -command do_add_all \
1861                -accelerator $M1T-I
1862        lappend disable_on_lock \
1863                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1864
1865        .mbar.commit add command -label [mc "Unstage From Commit"] \
1866                -command do_unstage_selection
1867        lappend disable_on_lock \
1868                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1869
1870        .mbar.commit add command -label [mc "Revert Changes"] \
1871                -command do_revert_selection
1872        lappend disable_on_lock \
1873                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1874
1875        .mbar.commit add separator
1876
1877        .mbar.commit add command -label [mc "Sign Off"] \
1878                -command do_signoff \
1879                -accelerator $M1T-S
1880
1881        .mbar.commit add command -label [mc Commit] \
1882                -command do_commit \
1883                -accelerator $M1T-Return
1884        lappend disable_on_lock \
1885                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1886}
1887
1888# -- Merge Menu
1889#
1890if {[is_enabled branch]} {
1891        menu .mbar.merge
1892        .mbar.merge add command -label [mc "Local Merge..."] \
1893                -command merge::dialog \
1894                -accelerator $M1T-M
1895        lappend disable_on_lock \
1896                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1897        .mbar.merge add command -label [mc "Abort Merge..."] \
1898                -command merge::reset_hard
1899        lappend disable_on_lock \
1900                [list .mbar.merge entryconf [.mbar.merge index last] -state]
1901}
1902
1903# -- Transport Menu
1904#
1905if {[is_enabled transport]} {
1906        menu .mbar.fetch
1907
1908        menu .mbar.push
1909        .mbar.push add command -label [mc "Push..."] \
1910                -command do_push_anywhere \
1911                -accelerator $M1T-P
1912        .mbar.push add command -label [mc "Delete..."] \
1913                -command remote_branch_delete::dialog
1914}
1915
1916if {[is_MacOSX]} {
1917        # -- Apple Menu (Mac OS X only)
1918        #
1919        .mbar add cascade -label [mc Apple] -menu .mbar.apple
1920        menu .mbar.apple
1921
1922        .mbar.apple add command -label [mc "About %s" [appname]] \
1923                -command do_about
1924        .mbar.apple add command -label [mc "Options..."] \
1925                -command do_options
1926} else {
1927        # -- Edit Menu
1928        #
1929        .mbar.edit add separator
1930        .mbar.edit add command -label [mc "Options..."] \
1931                -command do_options
1932}
1933
1934# -- Help Menu
1935#
1936.mbar add cascade -label [mc Help] -menu .mbar.help
1937menu .mbar.help
1938
1939if {![is_MacOSX]} {
1940        .mbar.help add command -label [mc "About %s" [appname]] \
1941                -command do_about
1942}
1943
1944set browser {}
1945catch {set browser $repo_config(instaweb.browser)}
1946set doc_path [file dirname [gitexec]]
1947set doc_path [file join $doc_path Documentation index.html]
1948
1949if {[is_Cygwin]} {
1950        set doc_path [exec cygpath --mixed $doc_path]
1951}
1952
1953if {$browser eq {}} {
1954        if {[is_MacOSX]} {
1955                set browser open
1956        } elseif {[is_Cygwin]} {
1957                set program_files [file dirname [exec cygpath --windir]]
1958                set program_files [file join $program_files {Program Files}]
1959                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
1960                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
1961                if {[file exists $firefox]} {
1962                        set browser $firefox
1963                } elseif {[file exists $ie]} {
1964                        set browser $ie
1965                }
1966                unset program_files firefox ie
1967        }
1968}
1969
1970if {[file isfile $doc_path]} {
1971        set doc_url "file:$doc_path"
1972} else {
1973        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
1974}
1975
1976if {$browser ne {}} {
1977        .mbar.help add command -label [mc "Online Documentation"] \
1978                -command [list exec $browser $doc_url &]
1979}
1980unset browser doc_path doc_url
1981
1982set root_exists 0
1983bind . <Visibility> {
1984        bind . <Visibility> {}
1985        set root_exists 1
1986}
1987
1988# -- Standard bindings
1989#
1990wm protocol . WM_DELETE_WINDOW do_quit
1991bind all <$M1B-Key-q> do_quit
1992bind all <$M1B-Key-Q> do_quit
1993bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1994bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1995
1996set subcommand_args {}
1997proc usage {} {
1998        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
1999        exit 1
2000}
2001
2002# -- Not a normal commit type invocation?  Do that instead!
2003#
2004switch -- $subcommand {
2005browser -
2006blame {
2007        set subcommand_args {rev? path}
2008        if {$argv eq {}} usage
2009        set head {}
2010        set path {}
2011        set is_path 0
2012        foreach a $argv {
2013                if {$is_path || [file exists $_prefix$a]} {
2014                        if {$path ne {}} usage
2015                        set path $_prefix$a
2016                        break
2017                } elseif {$a eq {--}} {
2018                        if {$path ne {}} {
2019                                if {$head ne {}} usage
2020                                set head $path
2021                                set path {}
2022                        }
2023                        set is_path 1
2024                } elseif {$head eq {}} {
2025                        if {$head ne {}} usage
2026                        set head $a
2027                        set is_path 1
2028                } else {
2029                        usage
2030                }
2031        }
2032        unset is_path
2033
2034        if {$head ne {} && $path eq {}} {
2035                set path $_prefix$head
2036                set head {}
2037        }
2038
2039        if {$head eq {}} {
2040                load_current_branch
2041        } else {
2042                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2043                        if {[catch {
2044                                        set head [git rev-parse --verify $head]
2045                                } err]} {
2046                                puts stderr $err
2047                                exit 1
2048                        }
2049                }
2050                set current_branch $head
2051        }
2052
2053        switch -- $subcommand {
2054        browser {
2055                if {$head eq {}} {
2056                        if {$path ne {} && [file isdirectory $path]} {
2057                                set head $current_branch
2058                        } else {
2059                                set head $path
2060                                set path {}
2061                        }
2062                }
2063                browser::new $head $path
2064        }
2065        blame   {
2066                if {$head eq {} && ![file exists $path]} {
2067                        puts stderr "fatal: cannot stat path $path: No such file or directory"
2068                        exit 1
2069                }
2070                blame::new $head $path
2071        }
2072        }
2073        return
2074}
2075citool -
2076gui {
2077        if {[llength $argv] != 0} {
2078                puts -nonewline stderr "usage: $argv0"
2079                if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
2080                        puts -nonewline stderr " $subcommand"
2081                }
2082                puts stderr {}
2083                exit 1
2084        }
2085        # fall through to setup UI for commits
2086}
2087default {
2088        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2089        exit 1
2090}
2091}
2092
2093# -- Branch Control
2094#
2095frame .branch \
2096        -borderwidth 1 \
2097        -relief sunken
2098label .branch.l1 \
2099        -text [mc "Current Branch:"] \
2100        -anchor w \
2101        -justify left
2102label .branch.cb \
2103        -textvariable current_branch \
2104        -anchor w \
2105        -justify left
2106pack .branch.l1 -side left
2107pack .branch.cb -side left -fill x
2108pack .branch -side top -fill x
2109
2110# -- Main Window Layout
2111#
2112panedwindow .vpane -orient vertical
2113panedwindow .vpane.files -orient horizontal
2114.vpane add .vpane.files -sticky nsew -height 100 -width 200
2115pack .vpane -anchor n -side top -fill both -expand 1
2116
2117# -- Index File List
2118#
2119frame .vpane.files.index -height 100 -width 200
2120label .vpane.files.index.title -text [mc "Staged Changes (Will Be Committed)"] \
2121        -background lightgreen
2122text $ui_index -background white -borderwidth 0 \
2123        -width 20 -height 10 \
2124        -wrap none \
2125        -cursor $cursor_ptr \
2126        -xscrollcommand {.vpane.files.index.sx set} \
2127        -yscrollcommand {.vpane.files.index.sy set} \
2128        -state disabled
2129scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2130scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2131pack .vpane.files.index.title -side top -fill x
2132pack .vpane.files.index.sx -side bottom -fill x
2133pack .vpane.files.index.sy -side right -fill y
2134pack $ui_index -side left -fill both -expand 1
2135.vpane.files add .vpane.files.index -sticky nsew
2136
2137# -- Working Directory File List
2138#
2139frame .vpane.files.workdir -height 100 -width 200
2140label .vpane.files.workdir.title -text [mc "Unstaged Changes (Will Not Be Committed)"] \
2141        -background lightsalmon
2142text $ui_workdir -background white -borderwidth 0 \
2143        -width 20 -height 10 \
2144        -wrap none \
2145        -cursor $cursor_ptr \
2146        -xscrollcommand {.vpane.files.workdir.sx set} \
2147        -yscrollcommand {.vpane.files.workdir.sy set} \
2148        -state disabled
2149scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2150scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2151pack .vpane.files.workdir.title -side top -fill x
2152pack .vpane.files.workdir.sx -side bottom -fill x
2153pack .vpane.files.workdir.sy -side right -fill y
2154pack $ui_workdir -side left -fill both -expand 1
2155.vpane.files add .vpane.files.workdir -sticky nsew
2156
2157foreach i [list $ui_index $ui_workdir] {
2158        $i tag conf in_diff -background lightgray
2159        $i tag conf in_sel  -background lightgray
2160}
2161unset i
2162
2163# -- Diff and Commit Area
2164#
2165frame .vpane.lower -height 300 -width 400
2166frame .vpane.lower.commarea
2167frame .vpane.lower.diff -relief sunken -borderwidth 1
2168pack .vpane.lower.commarea -side top -fill x
2169pack .vpane.lower.diff -side bottom -fill both -expand 1
2170.vpane add .vpane.lower -sticky nsew
2171
2172# -- Commit Area Buttons
2173#
2174frame .vpane.lower.commarea.buttons
2175label .vpane.lower.commarea.buttons.l -text {} \
2176        -anchor w \
2177        -justify left
2178pack .vpane.lower.commarea.buttons.l -side top -fill x
2179pack .vpane.lower.commarea.buttons -side left -fill y
2180
2181button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2182        -command do_rescan
2183pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2184lappend disable_on_lock \
2185        {.vpane.lower.commarea.buttons.rescan conf -state}
2186
2187button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2188        -command do_add_all
2189pack .vpane.lower.commarea.buttons.incall -side top -fill x
2190lappend disable_on_lock \
2191        {.vpane.lower.commarea.buttons.incall conf -state}
2192
2193button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2194        -command do_signoff
2195pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2196
2197button .vpane.lower.commarea.buttons.commit -text [mc Commit] \
2198        -command do_commit
2199pack .vpane.lower.commarea.buttons.commit -side top -fill x
2200lappend disable_on_lock \
2201        {.vpane.lower.commarea.buttons.commit conf -state}
2202
2203button .vpane.lower.commarea.buttons.push -text [mc Push] \
2204        -command do_push_anywhere
2205pack .vpane.lower.commarea.buttons.push -side top -fill x
2206
2207# -- Commit Message Buffer
2208#
2209frame .vpane.lower.commarea.buffer
2210frame .vpane.lower.commarea.buffer.header
2211set ui_comm .vpane.lower.commarea.buffer.t
2212set ui_coml .vpane.lower.commarea.buffer.header.l
2213radiobutton .vpane.lower.commarea.buffer.header.new \
2214        -text [mc "New Commit"] \
2215        -command do_select_commit_type \
2216        -variable selected_commit_type \
2217        -value new
2218lappend disable_on_lock \
2219        [list .vpane.lower.commarea.buffer.header.new conf -state]
2220radiobutton .vpane.lower.commarea.buffer.header.amend \
2221        -text [mc "Amend Last Commit"] \
2222        -command do_select_commit_type \
2223        -variable selected_commit_type \
2224        -value amend
2225lappend disable_on_lock \
2226        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2227label $ui_coml \
2228        -anchor w \
2229        -justify left
2230proc trace_commit_type {varname args} {
2231        global ui_coml commit_type
2232        switch -glob -- $commit_type {
2233        initial       {set txt [mc "Initial Commit Message:"]}
2234        amend         {set txt [mc "Amended Commit Message:"]}
2235        amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2236        amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2237        merge         {set txt [mc "Merge Commit Message:"]}
2238        *             {set txt [mc "Commit Message:"]}
2239        }
2240        $ui_coml conf -text $txt
2241}
2242trace add variable commit_type write trace_commit_type
2243pack $ui_coml -side left -fill x
2244pack .vpane.lower.commarea.buffer.header.amend -side right
2245pack .vpane.lower.commarea.buffer.header.new -side right
2246
2247text $ui_comm -background white -borderwidth 1 \
2248        -undo true \
2249        -maxundo 20 \
2250        -autoseparators true \
2251        -relief sunken \
2252        -width 75 -height 9 -wrap none \
2253        -font font_diff \
2254        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2255scrollbar .vpane.lower.commarea.buffer.sby \
2256        -command [list $ui_comm yview]
2257pack .vpane.lower.commarea.buffer.header -side top -fill x
2258pack .vpane.lower.commarea.buffer.sby -side right -fill y
2259pack $ui_comm -side left -fill y
2260pack .vpane.lower.commarea.buffer -side left -fill y
2261
2262# -- Commit Message Buffer Context Menu
2263#
2264set ctxm .vpane.lower.commarea.buffer.ctxm
2265menu $ctxm -tearoff 0
2266$ctxm add command \
2267        -label [mc Cut] \
2268        -command {tk_textCut $ui_comm}
2269$ctxm add command \
2270        -label [mc Copy] \
2271        -command {tk_textCopy $ui_comm}
2272$ctxm add command \
2273        -label [mc Paste] \
2274        -command {tk_textPaste $ui_comm}
2275$ctxm add command \
2276        -label [mc Delete] \
2277        -command {$ui_comm delete sel.first sel.last}
2278$ctxm add separator
2279$ctxm add command \
2280        -label [mc "Select All"] \
2281        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2282$ctxm add command \
2283        -label [mc "Copy All"] \
2284        -command {
2285                $ui_comm tag add sel 0.0 end
2286                tk_textCopy $ui_comm
2287                $ui_comm tag remove sel 0.0 end
2288        }
2289$ctxm add separator
2290$ctxm add command \
2291        -label [mc "Sign Off"] \
2292        -command do_signoff
2293bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2294
2295# -- Diff Header
2296#
2297proc trace_current_diff_path {varname args} {
2298        global current_diff_path diff_actions file_states
2299        if {$current_diff_path eq {}} {
2300                set s {}
2301                set f {}
2302                set p {}
2303                set o disabled
2304        } else {
2305                set p $current_diff_path
2306                set s [mapdesc [lindex $file_states($p) 0] $p]
2307                set f [mc "File:"]
2308                set p [escape_path $p]
2309                set o normal
2310        }
2311
2312        .vpane.lower.diff.header.status configure -text $s
2313        .vpane.lower.diff.header.file configure -text $f
2314        .vpane.lower.diff.header.path configure -text $p
2315        foreach w $diff_actions {
2316                uplevel #0 $w $o
2317        }
2318}
2319trace add variable current_diff_path write trace_current_diff_path
2320
2321frame .vpane.lower.diff.header -background gold
2322label .vpane.lower.diff.header.status \
2323        -background gold \
2324        -width $max_status_desc \
2325        -anchor w \
2326        -justify left
2327label .vpane.lower.diff.header.file \
2328        -background gold \
2329        -anchor w \
2330        -justify left
2331label .vpane.lower.diff.header.path \
2332        -background gold \
2333        -anchor w \
2334        -justify left
2335pack .vpane.lower.diff.header.status -side left
2336pack .vpane.lower.diff.header.file -side left
2337pack .vpane.lower.diff.header.path -fill x
2338set ctxm .vpane.lower.diff.header.ctxm
2339menu $ctxm -tearoff 0
2340$ctxm add command \
2341        -label [mc Copy] \
2342        -command {
2343                clipboard clear
2344                clipboard append \
2345                        -format STRING \
2346                        -type STRING \
2347                        -- $current_diff_path
2348        }
2349lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2350bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2351
2352# -- Diff Body
2353#
2354frame .vpane.lower.diff.body
2355set ui_diff .vpane.lower.diff.body.t
2356text $ui_diff -background white -borderwidth 0 \
2357        -width 80 -height 15 -wrap none \
2358        -font font_diff \
2359        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2360        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2361        -state disabled
2362scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2363        -command [list $ui_diff xview]
2364scrollbar .vpane.lower.diff.body.sby -orient vertical \
2365        -command [list $ui_diff yview]
2366pack .vpane.lower.diff.body.sbx -side bottom -fill x
2367pack .vpane.lower.diff.body.sby -side right -fill y
2368pack $ui_diff -side left -fill both -expand 1
2369pack .vpane.lower.diff.header -side top -fill x
2370pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2371
2372$ui_diff tag conf d_cr -elide true
2373$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2374$ui_diff tag conf d_+ -foreground {#00a000}
2375$ui_diff tag conf d_- -foreground red
2376
2377$ui_diff tag conf d_++ -foreground {#00a000}
2378$ui_diff tag conf d_-- -foreground red
2379$ui_diff tag conf d_+s \
2380        -foreground {#00a000} \
2381        -background {#e2effa}
2382$ui_diff tag conf d_-s \
2383        -foreground red \
2384        -background {#e2effa}
2385$ui_diff tag conf d_s+ \
2386        -foreground {#00a000} \
2387        -background ivory1
2388$ui_diff tag conf d_s- \
2389        -foreground red \
2390        -background ivory1
2391
2392$ui_diff tag conf d<<<<<<< \
2393        -foreground orange \
2394        -font font_diffbold
2395$ui_diff tag conf d======= \
2396        -foreground orange \
2397        -font font_diffbold
2398$ui_diff tag conf d>>>>>>> \
2399        -foreground orange \
2400        -font font_diffbold
2401
2402$ui_diff tag raise sel
2403
2404# -- Diff Body Context Menu
2405#
2406set ctxm .vpane.lower.diff.body.ctxm
2407menu $ctxm -tearoff 0
2408$ctxm add command \
2409        -label [mc Refresh] \
2410        -command reshow_diff
2411lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2412$ctxm add command \
2413        -label [mc Copy] \
2414        -command {tk_textCopy $ui_diff}
2415lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2416$ctxm add command \
2417        -label [mc "Select All"] \
2418        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2419lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2420$ctxm add command \
2421        -label [mc "Copy All"] \
2422        -command {
2423                $ui_diff tag add sel 0.0 end
2424                tk_textCopy $ui_diff
2425                $ui_diff tag remove sel 0.0 end
2426        }
2427lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2428$ctxm add separator
2429$ctxm add command \
2430        -label [mc "Apply/Reverse Hunk"] \
2431        -command {apply_hunk $cursorX $cursorY}
2432set ui_diff_applyhunk [$ctxm index last]
2433lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2434$ctxm add separator
2435$ctxm add command \
2436        -label [mc "Decrease Font Size"] \
2437        -command {incr_font_size font_diff -1}
2438lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2439$ctxm add command \
2440        -label [mc "Increase Font Size"] \
2441        -command {incr_font_size font_diff 1}
2442lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2443$ctxm add separator
2444$ctxm add command \
2445        -label [mc "Show Less Context"] \
2446        -command {if {$repo_config(gui.diffcontext) >= 1} {
2447                incr repo_config(gui.diffcontext) -1
2448                reshow_diff
2449        }}
2450lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2451$ctxm add command \
2452        -label [mc "Show More Context"] \
2453        -command {if {$repo_config(gui.diffcontext) < 99} {
2454                incr repo_config(gui.diffcontext)
2455                reshow_diff
2456        }}
2457lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2458$ctxm add separator
2459$ctxm add command -label [mc "Options..."] \
2460        -command do_options
2461proc popup_diff_menu {ctxm x y X Y} {
2462        global current_diff_path file_states
2463        set ::cursorX $x
2464        set ::cursorY $y
2465        if {$::ui_index eq $::current_diff_side} {
2466                set l [mc "Unstage Hunk From Commit"]
2467        } else {
2468                set l [mc "Stage Hunk For Commit"]
2469        }
2470        if {$::is_3way_diff
2471                || $current_diff_path eq {}
2472                || ![info exists file_states($current_diff_path)]
2473                || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2474                set s disabled
2475        } else {
2476                set s normal
2477        }
2478        $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2479        tk_popup $ctxm $X $Y
2480}
2481bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2482
2483# -- Status Bar
2484#
2485set main_status [::status_bar::new .status]
2486pack .status -anchor w -side bottom -fill x
2487$main_status show [mc "Initializing..."]
2488
2489# -- Load geometry
2490#
2491catch {
2492set gm $repo_config(gui.geometry)
2493wm geometry . [lindex $gm 0]
2494.vpane sash place 0 \
2495        [lindex [.vpane sash coord 0] 0] \
2496        [lindex $gm 1]
2497.vpane.files sash place 0 \
2498        [lindex $gm 2] \
2499        [lindex [.vpane.files sash coord 0] 1]
2500unset gm
2501}
2502
2503# -- Key Bindings
2504#
2505bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2506bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2507bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2508bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2509bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2510bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2511bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2512bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2513bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2514bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2515bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2516
2517bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2518bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2519bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2520bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2521bind $ui_diff <$M1B-Key-v> {break}
2522bind $ui_diff <$M1B-Key-V> {break}
2523bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2524bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2525bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2526bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2527bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2528bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2529bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2530bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2531bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2532bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2533bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2534bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2535bind $ui_diff <Button-1>   {focus %W}
2536
2537if {[is_enabled branch]} {
2538        bind . <$M1B-Key-n> branch_create::dialog
2539        bind . <$M1B-Key-N> branch_create::dialog
2540        bind . <$M1B-Key-o> branch_checkout::dialog
2541        bind . <$M1B-Key-O> branch_checkout::dialog
2542        bind . <$M1B-Key-m> merge::dialog
2543        bind . <$M1B-Key-M> merge::dialog
2544}
2545if {[is_enabled transport]} {
2546        bind . <$M1B-Key-p> do_push_anywhere
2547        bind . <$M1B-Key-P> do_push_anywhere
2548}
2549
2550bind .   <Key-F5>     do_rescan
2551bind .   <$M1B-Key-r> do_rescan
2552bind .   <$M1B-Key-R> do_rescan
2553bind .   <$M1B-Key-s> do_signoff
2554bind .   <$M1B-Key-S> do_signoff
2555bind .   <$M1B-Key-i> do_add_all
2556bind .   <$M1B-Key-I> do_add_all
2557bind .   <$M1B-Key-Return> do_commit
2558foreach i [list $ui_index $ui_workdir] {
2559        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2560        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2561        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2562}
2563unset i
2564
2565set file_lists($ui_index) [list]
2566set file_lists($ui_workdir) [list]
2567
2568wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2569focus -force $ui_comm
2570
2571# -- Warn the user about environmental problems.  Cygwin's Tcl
2572#    does *not* pass its env array onto any processes it spawns.
2573#    This means that git processes get none of our environment.
2574#
2575if {[is_Cygwin]} {
2576        set ignored_env 0
2577        set suggest_user {}
2578        set msg "Possible environment issues exist.
2579
2580The following environment variables are probably
2581going to be ignored by any Git subprocess run
2582by [appname]:
2583
2584"
2585        foreach name [array names env] {
2586                switch -regexp -- $name {
2587                {^GIT_INDEX_FILE$} -
2588                {^GIT_OBJECT_DIRECTORY$} -
2589                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2590                {^GIT_DIFF_OPTS$} -
2591                {^GIT_EXTERNAL_DIFF$} -
2592                {^GIT_PAGER$} -
2593                {^GIT_TRACE$} -
2594                {^GIT_CONFIG$} -
2595                {^GIT_CONFIG_LOCAL$} -
2596                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2597                        append msg " - $name\n"
2598                        incr ignored_env
2599                }
2600                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2601                        append msg " - $name\n"
2602                        incr ignored_env
2603                        set suggest_user $name
2604                }
2605                }
2606        }
2607        if {$ignored_env > 0} {
2608                append msg "
2609This is due to a known issue with the
2610Tcl binary distributed by Cygwin."
2611
2612                if {$suggest_user ne {}} {
2613                        append msg "
2614
2615A good replacement for $suggest_user
2616is placing values for the user.name and
2617user.email settings into your personal
2618~/.gitconfig file.
2619"
2620                }
2621                warn_popup $msg
2622        }
2623        unset ignored_env msg suggest_user name
2624}
2625
2626# -- Only initialize complex UI if we are going to stay running.
2627#
2628if {[is_enabled transport]} {
2629        load_all_remotes
2630
2631        populate_fetch_menu
2632        populate_push_menu
2633}
2634
2635if {[winfo exists $ui_comm]} {
2636        set GITGUI_BCK_exists [load_message GITGUI_BCK]
2637
2638        # -- If both our backup and message files exist use the
2639        #    newer of the two files to initialize the buffer.
2640        #
2641        if {$GITGUI_BCK_exists} {
2642                set m [gitdir GITGUI_MSG]
2643                if {[file isfile $m]} {
2644                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2645                                catch {file delete [gitdir GITGUI_MSG]}
2646                        } else {
2647                                $ui_comm delete 0.0 end
2648                                $ui_comm edit reset
2649                                $ui_comm edit modified false
2650                                catch {file delete [gitdir GITGUI_BCK]}
2651                                set GITGUI_BCK_exists 0
2652                        }
2653                }
2654                unset m
2655        }
2656
2657        proc backup_commit_buffer {} {
2658                global ui_comm GITGUI_BCK_exists
2659
2660                set m [$ui_comm edit modified]
2661                if {$m || $GITGUI_BCK_exists} {
2662                        set msg [string trim [$ui_comm get 0.0 end]]
2663                        regsub -all -line {[ \r\t]+$} $msg {} msg
2664
2665                        if {$msg eq {}} {
2666                                if {$GITGUI_BCK_exists} {
2667                                        catch {file delete [gitdir GITGUI_BCK]}
2668                                        set GITGUI_BCK_exists 0
2669                                }
2670                        } elseif {$m} {
2671                                catch {
2672                                        set fd [open [gitdir GITGUI_BCK] w]
2673                                        puts -nonewline $fd $msg
2674                                        close $fd
2675                                        set GITGUI_BCK_exists 1
2676                                }
2677                        }
2678
2679                        $ui_comm edit modified false
2680                }
2681
2682                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2683        }
2684
2685        backup_commit_buffer
2686}
2687
2688lock_index begin-read
2689if {![winfo ismapped .]} {
2690        wm deiconify .
2691}
2692after 1 do_rescan
2693if {[is_enabled multicommit]} {
2694        after 1000 hint_gc
2695}