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