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