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