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