Andrew's git - gitweb.git/blob

b41e107d944cdd1b835fc1e00f32d70f10a32ac8
   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        lappend disable_on_lock \
1991                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1992
1993        .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
1994                -command do_add_all \
1995                -accelerator $M1T-I
1996        lappend disable_on_lock \
1997                [list .mbar.commit entryconf [.mbar.commit index last] -state]
1998
1999        .mbar.commit add command -label [mc "Unstage From Commit"] \
2000                -command do_unstage_selection
2001        lappend disable_on_lock \
2002                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2003
2004        .mbar.commit add command -label [mc "Revert Changes"] \
2005                -command do_revert_selection
2006        lappend disable_on_lock \
2007                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2008
2009        .mbar.commit add separator
2010
2011        .mbar.commit add command -label [mc "Sign Off"] \
2012                -command do_signoff \
2013                -accelerator $M1T-S
2014
2015        .mbar.commit add command -label [mc Commit@@verb] \
2016                -command do_commit \
2017                -accelerator $M1T-Return
2018        lappend disable_on_lock \
2019                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2020}
2021
2022# -- Merge Menu
2023#
2024if {[is_enabled branch]} {
2025        menu .mbar.merge
2026        .mbar.merge add command -label [mc "Local Merge..."] \
2027                -command merge::dialog \
2028                -accelerator $M1T-M
2029        lappend disable_on_lock \
2030                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2031        .mbar.merge add command -label [mc "Abort Merge..."] \
2032                -command merge::reset_hard
2033        lappend disable_on_lock \
2034                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2035}
2036
2037# -- Transport Menu
2038#
2039if {[is_enabled transport]} {
2040        menu .mbar.remote
2041
2042        .mbar.remote add command \
2043                -label [mc "Push..."] \
2044                -command do_push_anywhere \
2045                -accelerator $M1T-P
2046        .mbar.remote add command \
2047                -label [mc "Delete..."] \
2048                -command remote_branch_delete::dialog
2049}
2050
2051if {[is_MacOSX]} {
2052        # -- Apple Menu (Mac OS X only)
2053        #
2054        .mbar add cascade -label [mc Apple] -menu .mbar.apple
2055        menu .mbar.apple
2056
2057        .mbar.apple add command -label [mc "About %s" [appname]] \
2058                -command do_about
2059        .mbar.apple add separator
2060        .mbar.apple add command \
2061                -label [mc "Preferences..."] \
2062                -command do_options \
2063                -accelerator $M1T-,
2064        bind . <$M1B-,> do_options
2065} else {
2066        # -- Edit Menu
2067        #
2068        .mbar.edit add separator
2069        .mbar.edit add command -label [mc "Options..."] \
2070                -command do_options
2071}
2072
2073# -- Help Menu
2074#
2075.mbar add cascade -label [mc Help] -menu .mbar.help
2076menu .mbar.help
2077
2078if {![is_MacOSX]} {
2079        .mbar.help add command -label [mc "About %s" [appname]] \
2080                -command do_about
2081}
2082
2083set browser {}
2084catch {set browser $repo_config(instaweb.browser)}
2085set doc_path [file dirname [gitexec]]
2086set doc_path [file join $doc_path Documentation index.html]
2087
2088if {[is_Cygwin]} {
2089        set doc_path [exec cygpath --mixed $doc_path]
2090}
2091
2092if {$browser eq {}} {
2093        if {[is_MacOSX]} {
2094                set browser open
2095        } elseif {[is_Cygwin]} {
2096                set program_files [file dirname [exec cygpath --windir]]
2097                set program_files [file join $program_files {Program Files}]
2098                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2099                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2100                if {[file exists $firefox]} {
2101                        set browser $firefox
2102                } elseif {[file exists $ie]} {
2103                        set browser $ie
2104                }
2105                unset program_files firefox ie
2106        }
2107}
2108
2109if {[file isfile $doc_path]} {
2110        set doc_url "file:$doc_path"
2111} else {
2112        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2113}
2114
2115if {$browser ne {}} {
2116        .mbar.help add command -label [mc "Online Documentation"] \
2117                -command [list exec $browser $doc_url &]
2118}
2119unset browser doc_path doc_url
2120
2121# -- Standard bindings
2122#
2123wm protocol . WM_DELETE_WINDOW do_quit
2124bind all <$M1B-Key-q> do_quit
2125bind all <$M1B-Key-Q> do_quit
2126bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2127bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2128
2129set subcommand_args {}
2130proc usage {} {
2131        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2132        exit 1
2133}
2134
2135# -- Not a normal commit type invocation?  Do that instead!
2136#
2137switch -- $subcommand {
2138browser -
2139blame {
2140        set subcommand_args {rev? path}
2141        if {$argv eq {}} usage
2142        set head {}
2143        set path {}
2144        set is_path 0
2145        foreach a $argv {
2146                if {$is_path || [file exists $_prefix$a]} {
2147                        if {$path ne {}} usage
2148                        set path $_prefix$a
2149                        break
2150                } elseif {$a eq {--}} {
2151                        if {$path ne {}} {
2152                                if {$head ne {}} usage
2153                                set head $path
2154                                set path {}
2155                        }
2156                        set is_path 1
2157                } elseif {$head eq {}} {
2158                        if {$head ne {}} usage
2159                        set head $a
2160                        set is_path 1
2161                } else {
2162                        usage
2163                }
2164        }
2165        unset is_path
2166
2167        if {$head ne {} && $path eq {}} {
2168                set path $_prefix$head
2169                set head {}
2170        }
2171
2172        if {$head eq {}} {
2173                load_current_branch
2174        } else {
2175                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2176                        if {[catch {
2177                                        set head [git rev-parse --verify $head]
2178                                } err]} {
2179                                puts stderr $err
2180                                exit 1
2181                        }
2182                }
2183                set current_branch $head
2184        }
2185
2186        switch -- $subcommand {
2187        browser {
2188                if {$head eq {}} {
2189                        if {$path ne {} && [file isdirectory $path]} {
2190                                set head $current_branch
2191                        } else {
2192                                set head $path
2193                                set path {}
2194                        }
2195                }
2196                browser::new $head $path
2197        }
2198        blame   {
2199                if {$head eq {} && ![file exists $path]} {
2200                        puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2201                        exit 1
2202                }
2203                blame::new $head $path
2204        }
2205        }
2206        return
2207}
2208citool -
2209gui {
2210        if {[llength $argv] != 0} {
2211                puts -nonewline stderr "usage: $argv0"
2212                if {$subcommand ne {gui}
2213                        && [file tail $argv0] ne "git-$subcommand"} {
2214                        puts -nonewline stderr " $subcommand"
2215                }
2216                puts stderr {}
2217                exit 1
2218        }
2219        # fall through to setup UI for commits
2220}
2221default {
2222        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2223        exit 1
2224}
2225}
2226
2227# -- Branch Control
2228#
2229frame .branch \
2230        -borderwidth 1 \
2231        -relief sunken
2232label .branch.l1 \
2233        -text [mc "Current Branch:"] \
2234        -anchor w \
2235        -justify left
2236label .branch.cb \
2237        -textvariable current_branch \
2238        -anchor w \
2239        -justify left
2240pack .branch.l1 -side left
2241pack .branch.cb -side left -fill x
2242pack .branch -side top -fill x
2243
2244# -- Main Window Layout
2245#
2246panedwindow .vpane -orient horizontal
2247panedwindow .vpane.files -orient vertical
2248.vpane add .vpane.files -sticky nsew -height 100 -width 200
2249pack .vpane -anchor n -side top -fill both -expand 1
2250
2251# -- Index File List
2252#
2253frame .vpane.files.index -height 100 -width 200
2254label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2255        -background lightgreen
2256text $ui_index -background white -borderwidth 0 \
2257        -width 20 -height 10 \
2258        -wrap none \
2259        -cursor $cursor_ptr \
2260        -xscrollcommand {.vpane.files.index.sx set} \
2261        -yscrollcommand {.vpane.files.index.sy set} \
2262        -state disabled
2263scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2264scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2265pack .vpane.files.index.title -side top -fill x
2266pack .vpane.files.index.sx -side bottom -fill x
2267pack .vpane.files.index.sy -side right -fill y
2268pack $ui_index -side left -fill both -expand 1
2269
2270# -- Working Directory File List
2271#
2272frame .vpane.files.workdir -height 100 -width 200
2273label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2274        -background lightsalmon
2275text $ui_workdir -background white -borderwidth 0 \
2276        -width 20 -height 10 \
2277        -wrap none \
2278        -cursor $cursor_ptr \
2279        -xscrollcommand {.vpane.files.workdir.sx set} \
2280        -yscrollcommand {.vpane.files.workdir.sy set} \
2281        -state disabled
2282scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2283scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2284pack .vpane.files.workdir.title -side top -fill x
2285pack .vpane.files.workdir.sx -side bottom -fill x
2286pack .vpane.files.workdir.sy -side right -fill y
2287pack $ui_workdir -side left -fill both -expand 1
2288
2289.vpane.files add .vpane.files.workdir -sticky nsew
2290.vpane.files add .vpane.files.index -sticky nsew
2291
2292foreach i [list $ui_index $ui_workdir] {
2293        rmsel_tag $i
2294        $i tag conf in_diff -background [$i tag cget in_sel -background]
2295}
2296unset i
2297
2298# -- Diff and Commit Area
2299#
2300frame .vpane.lower -height 300 -width 400
2301frame .vpane.lower.commarea
2302frame .vpane.lower.diff -relief sunken -borderwidth 1
2303pack .vpane.lower.diff -fill both -expand 1
2304pack .vpane.lower.commarea -side bottom -fill x
2305.vpane add .vpane.lower -sticky nsew
2306
2307# -- Commit Area Buttons
2308#
2309frame .vpane.lower.commarea.buttons
2310label .vpane.lower.commarea.buttons.l -text {} \
2311        -anchor w \
2312        -justify left
2313pack .vpane.lower.commarea.buttons.l -side top -fill x
2314pack .vpane.lower.commarea.buttons -side left -fill y
2315
2316button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2317        -command do_rescan
2318pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2319lappend disable_on_lock \
2320        {.vpane.lower.commarea.buttons.rescan conf -state}
2321
2322button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2323        -command do_add_all
2324pack .vpane.lower.commarea.buttons.incall -side top -fill x
2325lappend disable_on_lock \
2326        {.vpane.lower.commarea.buttons.incall conf -state}
2327
2328button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2329        -command do_signoff
2330pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2331
2332button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2333        -command do_commit
2334pack .vpane.lower.commarea.buttons.commit -side top -fill x
2335lappend disable_on_lock \
2336        {.vpane.lower.commarea.buttons.commit conf -state}
2337
2338button .vpane.lower.commarea.buttons.push -text [mc Push] \
2339        -command do_push_anywhere
2340pack .vpane.lower.commarea.buttons.push -side top -fill x
2341
2342# -- Commit Message Buffer
2343#
2344frame .vpane.lower.commarea.buffer
2345frame .vpane.lower.commarea.buffer.header
2346set ui_comm .vpane.lower.commarea.buffer.t
2347set ui_coml .vpane.lower.commarea.buffer.header.l
2348radiobutton .vpane.lower.commarea.buffer.header.new \
2349        -text [mc "New Commit"] \
2350        -command do_select_commit_type \
2351        -variable selected_commit_type \
2352        -value new
2353lappend disable_on_lock \
2354        [list .vpane.lower.commarea.buffer.header.new conf -state]
2355radiobutton .vpane.lower.commarea.buffer.header.amend \
2356        -text [mc "Amend Last Commit"] \
2357        -command do_select_commit_type \
2358        -variable selected_commit_type \
2359        -value amend
2360lappend disable_on_lock \
2361        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2362label $ui_coml \
2363        -anchor w \
2364        -justify left
2365proc trace_commit_type {varname args} {
2366        global ui_coml commit_type
2367        switch -glob -- $commit_type {
2368        initial       {set txt [mc "Initial Commit Message:"]}
2369        amend         {set txt [mc "Amended Commit Message:"]}
2370        amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2371        amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2372        merge         {set txt [mc "Merge Commit Message:"]}
2373        *             {set txt [mc "Commit Message:"]}
2374        }
2375        $ui_coml conf -text $txt
2376}
2377trace add variable commit_type write trace_commit_type
2378pack $ui_coml -side left -fill x
2379pack .vpane.lower.commarea.buffer.header.amend -side right
2380pack .vpane.lower.commarea.buffer.header.new -side right
2381
2382text $ui_comm -background white -borderwidth 1 \
2383        -undo true \
2384        -maxundo 20 \
2385        -autoseparators true \
2386        -relief sunken \
2387        -width 75 -height 9 -wrap none \
2388        -font font_diff \
2389        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2390scrollbar .vpane.lower.commarea.buffer.sby \
2391        -command [list $ui_comm yview]
2392pack .vpane.lower.commarea.buffer.header -side top -fill x
2393pack .vpane.lower.commarea.buffer.sby -side right -fill y
2394pack $ui_comm -side left -fill y
2395pack .vpane.lower.commarea.buffer -side left -fill y
2396
2397# -- Commit Message Buffer Context Menu
2398#
2399set ctxm .vpane.lower.commarea.buffer.ctxm
2400menu $ctxm -tearoff 0
2401$ctxm add command \
2402        -label [mc Cut] \
2403        -command {tk_textCut $ui_comm}
2404$ctxm add command \
2405        -label [mc Copy] \
2406        -command {tk_textCopy $ui_comm}
2407$ctxm add command \
2408        -label [mc Paste] \
2409        -command {tk_textPaste $ui_comm}
2410$ctxm add command \
2411        -label [mc Delete] \
2412        -command {$ui_comm delete sel.first sel.last}
2413$ctxm add separator
2414$ctxm add command \
2415        -label [mc "Select All"] \
2416        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2417$ctxm add command \
2418        -label [mc "Copy All"] \
2419        -command {
2420                $ui_comm tag add sel 0.0 end
2421                tk_textCopy $ui_comm
2422                $ui_comm tag remove sel 0.0 end
2423        }
2424$ctxm add separator
2425$ctxm add command \
2426        -label [mc "Sign Off"] \
2427        -command do_signoff
2428bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2429
2430# -- Diff Header
2431#
2432proc trace_current_diff_path {varname args} {
2433        global current_diff_path diff_actions file_states
2434        if {$current_diff_path eq {}} {
2435                set s {}
2436                set f {}
2437                set p {}
2438                set o disabled
2439        } else {
2440                set p $current_diff_path
2441                set s [mapdesc [lindex $file_states($p) 0] $p]
2442                set f [mc "File:"]
2443                set p [escape_path $p]
2444                set o normal
2445        }
2446
2447        .vpane.lower.diff.header.status configure -text $s
2448        .vpane.lower.diff.header.file configure -text $f
2449        .vpane.lower.diff.header.path configure -text $p
2450        foreach w $diff_actions {
2451                uplevel #0 $w $o
2452        }
2453}
2454trace add variable current_diff_path write trace_current_diff_path
2455
2456frame .vpane.lower.diff.header -background gold
2457label .vpane.lower.diff.header.status \
2458        -background gold \
2459        -width $max_status_desc \
2460        -anchor w \
2461        -justify left
2462label .vpane.lower.diff.header.file \
2463        -background gold \
2464        -anchor w \
2465        -justify left
2466label .vpane.lower.diff.header.path \
2467        -background gold \
2468        -anchor w \
2469        -justify left
2470pack .vpane.lower.diff.header.status -side left
2471pack .vpane.lower.diff.header.file -side left
2472pack .vpane.lower.diff.header.path -fill x
2473set ctxm .vpane.lower.diff.header.ctxm
2474menu $ctxm -tearoff 0
2475$ctxm add command \
2476        -label [mc Copy] \
2477        -command {
2478                clipboard clear
2479                clipboard append \
2480                        -format STRING \
2481                        -type STRING \
2482                        -- $current_diff_path
2483        }
2484lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2485bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2486
2487# -- Diff Body
2488#
2489frame .vpane.lower.diff.body
2490set ui_diff .vpane.lower.diff.body.t
2491text $ui_diff -background white -borderwidth 0 \
2492        -width 80 -height 15 -wrap none \
2493        -font font_diff \
2494        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2495        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2496        -state disabled
2497scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2498        -command [list $ui_diff xview]
2499scrollbar .vpane.lower.diff.body.sby -orient vertical \
2500        -command [list $ui_diff yview]
2501pack .vpane.lower.diff.body.sbx -side bottom -fill x
2502pack .vpane.lower.diff.body.sby -side right -fill y
2503pack $ui_diff -side left -fill both -expand 1
2504pack .vpane.lower.diff.header -side top -fill x
2505pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2506
2507$ui_diff tag conf d_cr -elide true
2508$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2509$ui_diff tag conf d_+ -foreground {#00a000}
2510$ui_diff tag conf d_- -foreground red
2511
2512$ui_diff tag conf d_++ -foreground {#00a000}
2513$ui_diff tag conf d_-- -foreground red
2514$ui_diff tag conf d_+s \
2515        -foreground {#00a000} \
2516        -background {#e2effa}
2517$ui_diff tag conf d_-s \
2518        -foreground red \
2519        -background {#e2effa}
2520$ui_diff tag conf d_s+ \
2521        -foreground {#00a000} \
2522        -background ivory1
2523$ui_diff tag conf d_s- \
2524        -foreground red \
2525        -background ivory1
2526
2527$ui_diff tag conf d<<<<<<< \
2528        -foreground orange \
2529        -font font_diffbold
2530$ui_diff tag conf d======= \
2531        -foreground orange \
2532        -font font_diffbold
2533$ui_diff tag conf d>>>>>>> \
2534        -foreground orange \
2535        -font font_diffbold
2536
2537$ui_diff tag raise sel
2538
2539# -- Diff Body Context Menu
2540#
2541set ctxm .vpane.lower.diff.body.ctxm
2542menu $ctxm -tearoff 0
2543$ctxm add command \
2544        -label [mc Refresh] \
2545        -command reshow_diff
2546lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2547$ctxm add command \
2548        -label [mc Copy] \
2549        -command {tk_textCopy $ui_diff}
2550lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2551$ctxm add command \
2552        -label [mc "Select All"] \
2553        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2554lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2555$ctxm add command \
2556        -label [mc "Copy All"] \
2557        -command {
2558                $ui_diff tag add sel 0.0 end
2559                tk_textCopy $ui_diff
2560                $ui_diff tag remove sel 0.0 end
2561        }
2562lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2563$ctxm add separator
2564$ctxm add command \
2565        -label [mc "Apply/Reverse Hunk"] \
2566        -command {apply_hunk $cursorX $cursorY}
2567set ui_diff_applyhunk [$ctxm index last]
2568lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2569$ctxm add separator
2570$ctxm add command \
2571        -label [mc "Decrease Font Size"] \
2572        -command {incr_font_size font_diff -1}
2573lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2574$ctxm add command \
2575        -label [mc "Increase Font Size"] \
2576        -command {incr_font_size font_diff 1}
2577lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2578$ctxm add separator
2579$ctxm add command \
2580        -label [mc "Show Less Context"] \
2581        -command {if {$repo_config(gui.diffcontext) >= 1} {
2582                incr repo_config(gui.diffcontext) -1
2583                reshow_diff
2584        }}
2585lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2586$ctxm add command \
2587        -label [mc "Show More Context"] \
2588        -command {if {$repo_config(gui.diffcontext) < 99} {
2589                incr repo_config(gui.diffcontext)
2590                reshow_diff
2591        }}
2592lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2593$ctxm add separator
2594$ctxm add command -label [mc "Options..."] \
2595        -command do_options
2596proc popup_diff_menu {ctxm x y X Y} {
2597        global current_diff_path file_states
2598        set ::cursorX $x
2599        set ::cursorY $y
2600        if {$::ui_index eq $::current_diff_side} {
2601                set l [mc "Unstage Hunk From Commit"]
2602        } else {
2603                set l [mc "Stage Hunk For Commit"]
2604        }
2605        if {$::is_3way_diff
2606                || $current_diff_path eq {}
2607                || ![info exists file_states($current_diff_path)]
2608                || {_O} eq [lindex $file_states($current_diff_path) 0]} {
2609                set s disabled
2610        } else {
2611                set s normal
2612        }
2613        $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2614        tk_popup $ctxm $X $Y
2615}
2616bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2617
2618# -- Status Bar
2619#
2620set main_status [::status_bar::new .status]
2621pack .status -anchor w -side bottom -fill x
2622$main_status show [mc "Initializing..."]
2623
2624# -- Load geometry
2625#
2626catch {
2627set gm $repo_config(gui.geometry)
2628wm geometry . [lindex $gm 0]
2629.vpane sash place 0 \
2630        [lindex $gm 1] \
2631        [lindex [.vpane sash coord 0] 1]
2632.vpane.files sash place 0 \
2633        [lindex [.vpane.files sash coord 0] 0] \
2634        [lindex $gm 2]
2635unset gm
2636}
2637
2638# -- Key Bindings
2639#
2640bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2641bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2642bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2643bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2644bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2645bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2646bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2647bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2648bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2649bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2650bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2651
2652bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2653bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2654bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2655bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2656bind $ui_diff <$M1B-Key-v> {break}
2657bind $ui_diff <$M1B-Key-V> {break}
2658bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2659bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2660bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2661bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2662bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2663bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2664bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2665bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2666bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2667bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2668bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2669bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2670bind $ui_diff <Button-1>   {focus %W}
2671
2672if {[is_enabled branch]} {
2673        bind . <$M1B-Key-n> branch_create::dialog
2674        bind . <$M1B-Key-N> branch_create::dialog
2675        bind . <$M1B-Key-o> branch_checkout::dialog
2676        bind . <$M1B-Key-O> branch_checkout::dialog
2677        bind . <$M1B-Key-m> merge::dialog
2678        bind . <$M1B-Key-M> merge::dialog
2679}
2680if {[is_enabled transport]} {
2681        bind . <$M1B-Key-p> do_push_anywhere
2682        bind . <$M1B-Key-P> do_push_anywhere
2683}
2684
2685bind .   <Key-F5>     do_rescan
2686bind .   <$M1B-Key-r> do_rescan
2687bind .   <$M1B-Key-R> do_rescan
2688bind .   <$M1B-Key-s> do_signoff
2689bind .   <$M1B-Key-S> do_signoff
2690bind .   <$M1B-Key-i> do_add_all
2691bind .   <$M1B-Key-I> do_add_all
2692bind .   <$M1B-Key-Return> do_commit
2693foreach i [list $ui_index $ui_workdir] {
2694        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2695        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2696        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2697}
2698unset i
2699
2700set file_lists($ui_index) [list]
2701set file_lists($ui_workdir) [list]
2702
2703wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2704focus -force $ui_comm
2705
2706# -- Warn the user about environmental problems.  Cygwin's Tcl
2707#    does *not* pass its env array onto any processes it spawns.
2708#    This means that git processes get none of our environment.
2709#
2710if {[is_Cygwin]} {
2711        set ignored_env 0
2712        set suggest_user {}
2713        set msg [mc "Possible environment issues exist.
2714
2715The following environment variables are probably
2716going to be ignored by any Git subprocess run
2717by %s:
2718
2719" [appname]]
2720        foreach name [array names env] {
2721                switch -regexp -- $name {
2722                {^GIT_INDEX_FILE$} -
2723                {^GIT_OBJECT_DIRECTORY$} -
2724                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2725                {^GIT_DIFF_OPTS$} -
2726                {^GIT_EXTERNAL_DIFF$} -
2727                {^GIT_PAGER$} -
2728                {^GIT_TRACE$} -
2729                {^GIT_CONFIG$} -
2730                {^GIT_CONFIG_LOCAL$} -
2731                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2732                        append msg " - $name\n"
2733                        incr ignored_env
2734                }
2735                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2736                        append msg " - $name\n"
2737                        incr ignored_env
2738                        set suggest_user $name
2739                }
2740                }
2741        }
2742        if {$ignored_env > 0} {
2743                append msg [mc "
2744This is due to a known issue with the
2745Tcl binary distributed by Cygwin."]
2746
2747                if {$suggest_user ne {}} {
2748                        append msg [mc "
2749
2750A good replacement for %s
2751is placing values for the user.name and
2752user.email settings into your personal
2753~/.gitconfig file.
2754" $suggest_user]
2755                }
2756                warn_popup $msg
2757        }
2758        unset ignored_env msg suggest_user name
2759}
2760
2761# -- Only initialize complex UI if we are going to stay running.
2762#
2763if {[is_enabled transport]} {
2764        load_all_remotes
2765
2766        set n [.mbar.remote index end]
2767        populate_push_menu
2768        populate_fetch_menu
2769        set n [expr {[.mbar.remote index end] - $n}]
2770        if {$n > 0} {
2771                .mbar.remote insert $n separator
2772        }
2773        unset n
2774}
2775
2776if {[winfo exists $ui_comm]} {
2777        set GITGUI_BCK_exists [load_message GITGUI_BCK]
2778
2779        # -- If both our backup and message files exist use the
2780        #    newer of the two files to initialize the buffer.
2781        #
2782        if {$GITGUI_BCK_exists} {
2783                set m [gitdir GITGUI_MSG]
2784                if {[file isfile $m]} {
2785                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2786                                catch {file delete [gitdir GITGUI_MSG]}
2787                        } else {
2788                                $ui_comm delete 0.0 end
2789                                $ui_comm edit reset
2790                                $ui_comm edit modified false
2791                                catch {file delete [gitdir GITGUI_BCK]}
2792                                set GITGUI_BCK_exists 0
2793                        }
2794                }
2795                unset m
2796        }
2797
2798        proc backup_commit_buffer {} {
2799                global ui_comm GITGUI_BCK_exists
2800
2801                set m [$ui_comm edit modified]
2802                if {$m || $GITGUI_BCK_exists} {
2803                        set msg [string trim [$ui_comm get 0.0 end]]
2804                        regsub -all -line {[ \r\t]+$} $msg {} msg
2805
2806                        if {$msg eq {}} {
2807                                if {$GITGUI_BCK_exists} {
2808                                        catch {file delete [gitdir GITGUI_BCK]}
2809                                        set GITGUI_BCK_exists 0
2810                                }
2811                        } elseif {$m} {
2812                                catch {
2813                                        set fd [open [gitdir GITGUI_BCK] w]
2814                                        puts -nonewline $fd $msg
2815                                        close $fd
2816                                        set GITGUI_BCK_exists 1
2817                                }
2818                        }
2819
2820                        $ui_comm edit modified false
2821                }
2822
2823                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
2824        }
2825
2826        backup_commit_buffer
2827}
2828
2829lock_index begin-read
2830if {![winfo ismapped .]} {
2831        wm deiconify .
2832}
2833after 1 do_rescan
2834if {[is_enabled multicommit]} {
2835        after 1000 hint_gc
2836}