c190cbe23f0c67f3866311506e4c5eaf47c87e80
   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 [string map [list (c) \u00a9] {
  14Copyright (c) 2006-2010 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 "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 normalize $argv0]]
  56        if {[file tail $oguilib] eq {git-core}} {
  57                set oguilib [file dirname $oguilib]
  58        }
  59        set oguilib [file dirname $oguilib]
  60        set oguilib [file join $oguilib share git-gui lib]
  61        set oguimsg [file join $oguilib msgs]
  62} elseif {[string match @@* $oguirel]} {
  63        set oguilib [file join [file dirname [file normalize $argv0]] lib]
  64        set oguimsg [file join [file dirname [file normalize $argv0]] po]
  65} else {
  66        set oguimsg [file join $oguilib msgs]
  67}
  68unset oguirel
  69
  70######################################################################
  71##
  72## enable verbose loading?
  73
  74if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  75        unset _verbose
  76        rename auto_load real__auto_load
  77        proc auto_load {name args} {
  78                puts stderr "auto_load $name"
  79                return [uplevel 1 real__auto_load $name $args]
  80        }
  81        rename source real__source
  82        proc source {name} {
  83                puts stderr "source    $name"
  84                uplevel 1 real__source $name
  85        }
  86        if {[tk windowingsystem] eq "win32"} { console show }
  87}
  88
  89######################################################################
  90##
  91## Internationalization (i18n) through msgcat and gettext. See
  92## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  93
  94package require msgcat
  95
  96# Check for Windows 7 MUI language pack (missed by msgcat < 1.4.4)
  97if {[tk windowingsystem] eq "win32"
  98        && [package vcompare [package provide msgcat] 1.4.4] < 0
  99} then {
 100        proc _mc_update_locale {} {
 101                set key {HKEY_CURRENT_USER\Control Panel\Desktop}
 102                if {![catch {
 103                        package require registry
 104                        set uilocale [registry get $key "PreferredUILanguages"]
 105                        msgcat::ConvertLocale [string map {- _} [lindex $uilocale 0]]
 106                } uilocale]} {
 107                        if {[string length $uilocale] > 0} {
 108                                msgcat::mclocale $uilocale
 109                        }
 110                }
 111        }
 112        _mc_update_locale
 113}
 114
 115proc _mc_trim {fmt} {
 116        set cmk [string first @@ $fmt]
 117        if {$cmk > 0} {
 118                return [string range $fmt 0 [expr {$cmk - 1}]]
 119        }
 120        return $fmt
 121}
 122
 123proc mc {en_fmt args} {
 124        set fmt [_mc_trim [::msgcat::mc $en_fmt]]
 125        if {[catch {set msg [eval [list format $fmt] $args]} err]} {
 126                set msg [eval [list format [_mc_trim $en_fmt]] $args]
 127        }
 128        return $msg
 129}
 130
 131proc strcat {args} {
 132        return [join $args {}]
 133}
 134
 135::msgcat::mcload $oguimsg
 136unset oguimsg
 137
 138######################################################################
 139##
 140## read only globals
 141
 142set _appname {Git Gui}
 143set _gitdir {}
 144set _gitworktree {}
 145set _isbare {}
 146set _gitexec {}
 147set _githtmldir {}
 148set _reponame {}
 149set _iscygwin {}
 150set _search_path {}
 151set _shellpath {@@SHELL_PATH@@}
 152
 153set _trace [lsearch -exact $argv --trace]
 154if {$_trace >= 0} {
 155        set argv [lreplace $argv $_trace $_trace]
 156        set _trace 1
 157} else {
 158        set _trace 0
 159}
 160
 161# variable for the last merged branch (useful for a default when deleting
 162# branches).
 163set _last_merged_branch {}
 164
 165proc shellpath {} {
 166        global _shellpath env
 167        if {[string match @@* $_shellpath]} {
 168                if {[info exists env(SHELL)]} {
 169                        return $env(SHELL)
 170                } else {
 171                        return /bin/sh
 172                }
 173        }
 174        return $_shellpath
 175}
 176
 177proc appname {} {
 178        global _appname
 179        return $_appname
 180}
 181
 182proc gitdir {args} {
 183        global _gitdir
 184        if {$args eq {}} {
 185                return $_gitdir
 186        }
 187        return [eval [list file join $_gitdir] $args]
 188}
 189
 190proc gitexec {args} {
 191        global _gitexec
 192        if {$_gitexec eq {}} {
 193                if {[catch {set _gitexec [git --exec-path]} err]} {
 194                        error "Git not installed?\n\n$err"
 195                }
 196                if {[is_Cygwin]} {
 197                        set _gitexec [exec cygpath \
 198                                --windows \
 199                                --absolute \
 200                                $_gitexec]
 201                } else {
 202                        set _gitexec [file normalize $_gitexec]
 203                }
 204        }
 205        if {$args eq {}} {
 206                return $_gitexec
 207        }
 208        return [eval [list file join $_gitexec] $args]
 209}
 210
 211proc githtmldir {args} {
 212        global _githtmldir
 213        if {$_githtmldir eq {}} {
 214                if {[catch {set _githtmldir [git --html-path]}]} {
 215                        # Git not installed or option not yet supported
 216                        return {}
 217                }
 218                if {[is_Cygwin]} {
 219                        set _githtmldir [exec cygpath \
 220                                --windows \
 221                                --absolute \
 222                                $_githtmldir]
 223                } else {
 224                        set _githtmldir [file normalize $_githtmldir]
 225                }
 226        }
 227        if {$args eq {}} {
 228                return $_githtmldir
 229        }
 230        return [eval [list file join $_githtmldir] $args]
 231}
 232
 233proc reponame {} {
 234        return $::_reponame
 235}
 236
 237proc is_MacOSX {} {
 238        if {[tk windowingsystem] eq {aqua}} {
 239                return 1
 240        }
 241        return 0
 242}
 243
 244proc is_Windows {} {
 245        if {$::tcl_platform(platform) eq {windows}} {
 246                return 1
 247        }
 248        return 0
 249}
 250
 251proc is_Cygwin {} {
 252        global _iscygwin
 253        if {$_iscygwin eq {}} {
 254                if {$::tcl_platform(platform) eq {windows}} {
 255                        if {[catch {set p [exec cygpath --windir]} err]} {
 256                                set _iscygwin 0
 257                        } else {
 258                                set _iscygwin 1
 259                        }
 260                } else {
 261                        set _iscygwin 0
 262                }
 263        }
 264        return $_iscygwin
 265}
 266
 267proc is_enabled {option} {
 268        global enabled_options
 269        if {[catch {set on $enabled_options($option)}]} {return 0}
 270        return $on
 271}
 272
 273proc enable_option {option} {
 274        global enabled_options
 275        set enabled_options($option) 1
 276}
 277
 278proc disable_option {option} {
 279        global enabled_options
 280        set enabled_options($option) 0
 281}
 282
 283######################################################################
 284##
 285## config
 286
 287proc is_many_config {name} {
 288        switch -glob -- $name {
 289        gui.recentrepo -
 290        remote.*.fetch -
 291        remote.*.push
 292                {return 1}
 293        *
 294                {return 0}
 295        }
 296}
 297
 298proc is_config_true {name} {
 299        global repo_config
 300        if {[catch {set v $repo_config($name)}]} {
 301                return 0
 302        }
 303        set v [string tolower $v]
 304        if {$v eq {} || $v eq {true} || $v eq {1} || $v eq {yes} || $v eq {on}} {
 305                return 1
 306        } else {
 307                return 0
 308        }
 309}
 310
 311proc is_config_false {name} {
 312        global repo_config
 313        if {[catch {set v $repo_config($name)}]} {
 314                return 0
 315        }
 316        set v [string tolower $v]
 317        if {$v eq {false} || $v eq {0} || $v eq {no} || $v eq {off}} {
 318                return 1
 319        } else {
 320                return 0
 321        }
 322}
 323
 324proc get_config {name} {
 325        global repo_config
 326        if {[catch {set v $repo_config($name)}]} {
 327                return {}
 328        } else {
 329                return $v
 330        }
 331}
 332
 333proc is_bare {} {
 334        global _isbare
 335        global _gitdir
 336        global _gitworktree
 337
 338        if {$_isbare eq {}} {
 339                if {[catch {
 340                        set _bare [git rev-parse --is-bare-repository]
 341                        switch  -- $_bare {
 342                        true { set _isbare 1 }
 343                        false { set _isbare 0}
 344                        default { throw }
 345                        }
 346                }]} {
 347                        if {[is_config_true core.bare]
 348                                || ($_gitworktree eq {}
 349                                        && [lindex [file split $_gitdir] end] ne {.git})} {
 350                                set _isbare 1
 351                        } else {
 352                                set _isbare 0
 353                        }
 354                }
 355        }
 356        return $_isbare
 357}
 358
 359######################################################################
 360##
 361## handy utils
 362
 363proc _trace_exec {cmd} {
 364        if {!$::_trace} return
 365        set d {}
 366        foreach v $cmd {
 367                if {$d ne {}} {
 368                        append d { }
 369                }
 370                if {[regexp {[ \t\r\n'"$?*]} $v]} {
 371                        set v [sq $v]
 372                }
 373                append d $v
 374        }
 375        puts stderr $d
 376}
 377
 378#'"  fix poor old emacs font-lock mode
 379
 380proc _git_cmd {name} {
 381        global _git_cmd_path
 382
 383        if {[catch {set v $_git_cmd_path($name)}]} {
 384                switch -- $name {
 385                  version   -
 386                --version   -
 387                --exec-path { return [list $::_git $name] }
 388                }
 389
 390                set p [gitexec git-$name$::_search_exe]
 391                if {[file exists $p]} {
 392                        set v [list $p]
 393                } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 394                        # Try to determine what sort of magic will make
 395                        # git-$name go and do its thing, because native
 396                        # Tcl on Windows doesn't know it.
 397                        #
 398                        set p [gitexec git-$name]
 399                        set f [open $p r]
 400                        set s [gets $f]
 401                        close $f
 402
 403                        switch -glob -- [lindex $s 0] {
 404                        #!*sh     { set i sh     }
 405                        #!*perl   { set i perl   }
 406                        #!*python { set i python }
 407                        default   { error "git-$name is not supported: $s" }
 408                        }
 409
 410                        upvar #0 _$i interp
 411                        if {![info exists interp]} {
 412                                set interp [_which $i]
 413                        }
 414                        if {$interp eq {}} {
 415                                error "git-$name requires $i (not in PATH)"
 416                        }
 417                        set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 418                } else {
 419                        # Assume it is builtin to git somehow and we
 420                        # aren't actually able to see a file for it.
 421                        #
 422                        set v [list $::_git $name]
 423                }
 424                set _git_cmd_path($name) $v
 425        }
 426        return $v
 427}
 428
 429proc _which {what args} {
 430        global env _search_exe _search_path
 431
 432        if {$_search_path eq {}} {
 433                if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
 434                        set _search_path [split [exec cygpath \
 435                                --windows \
 436                                --path \
 437                                --absolute \
 438                                $env(PATH)] {;}]
 439                        set _search_exe .exe
 440                } elseif {[is_Windows]} {
 441                        set gitguidir [file dirname [info script]]
 442                        regsub -all ";" $gitguidir "\\;" gitguidir
 443                        set env(PATH) "$gitguidir;$env(PATH)"
 444                        set _search_path [split $env(PATH) {;}]
 445                        set _search_exe .exe
 446                } else {
 447                        set _search_path [split $env(PATH) :]
 448                        set _search_exe {}
 449                }
 450        }
 451
 452        if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
 453                set suffix {}
 454        } else {
 455                set suffix $_search_exe
 456        }
 457
 458        foreach p $_search_path {
 459                set p [file join $p $what$suffix]
 460                if {[file exists $p]} {
 461                        return [file normalize $p]
 462                }
 463        }
 464        return {}
 465}
 466
 467proc _lappend_nice {cmd_var} {
 468        global _nice
 469        upvar $cmd_var cmd
 470
 471        if {![info exists _nice]} {
 472                set _nice [_which nice]
 473                if {[catch {exec $_nice git version}]} {
 474                        set _nice {}
 475                } elseif {[is_Windows] && [file dirname $_nice] ne [file dirname $::_git]} {
 476                        set _nice {}
 477                }
 478        }
 479        if {$_nice ne {}} {
 480                lappend cmd $_nice
 481        }
 482}
 483
 484proc git {args} {
 485        set opt [list]
 486
 487        while {1} {
 488                switch -- [lindex $args 0] {
 489                --nice {
 490                        _lappend_nice opt
 491                }
 492
 493                default {
 494                        break
 495                }
 496
 497                }
 498
 499                set args [lrange $args 1 end]
 500        }
 501
 502        set cmdp [_git_cmd [lindex $args 0]]
 503        set args [lrange $args 1 end]
 504
 505        _trace_exec [concat $opt $cmdp $args]
 506        set result [eval exec $opt $cmdp $args]
 507        if {$::_trace} {
 508                puts stderr "< $result"
 509        }
 510        return $result
 511}
 512
 513proc _open_stdout_stderr {cmd} {
 514        _trace_exec $cmd
 515        if {[catch {
 516                        set fd [open [concat [list | ] $cmd] r]
 517                } err]} {
 518                if {   [lindex $cmd end] eq {2>@1}
 519                    && $err eq {can not find channel named "1"}
 520                        } {
 521                        # Older versions of Tcl 8.4 don't have this 2>@1 IO
 522                        # redirect operator.  Fallback to |& cat for those.
 523                        # The command was not actually started, so its safe
 524                        # to try to start it a second time.
 525                        #
 526                        set fd [open [concat \
 527                                [list | ] \
 528                                [lrange $cmd 0 end-1] \
 529                                [list |& cat] \
 530                                ] r]
 531                } else {
 532                        error $err
 533                }
 534        }
 535        fconfigure $fd -eofchar {}
 536        return $fd
 537}
 538
 539proc git_read {args} {
 540        set opt [list]
 541
 542        while {1} {
 543                switch -- [lindex $args 0] {
 544                --nice {
 545                        _lappend_nice opt
 546                }
 547
 548                --stderr {
 549                        lappend args 2>@1
 550                }
 551
 552                default {
 553                        break
 554                }
 555
 556                }
 557
 558                set args [lrange $args 1 end]
 559        }
 560
 561        set cmdp [_git_cmd [lindex $args 0]]
 562        set args [lrange $args 1 end]
 563
 564        return [_open_stdout_stderr [concat $opt $cmdp $args]]
 565}
 566
 567proc git_write {args} {
 568        set opt [list]
 569
 570        while {1} {
 571                switch -- [lindex $args 0] {
 572                --nice {
 573                        _lappend_nice opt
 574                }
 575
 576                default {
 577                        break
 578                }
 579
 580                }
 581
 582                set args [lrange $args 1 end]
 583        }
 584
 585        set cmdp [_git_cmd [lindex $args 0]]
 586        set args [lrange $args 1 end]
 587
 588        _trace_exec [concat $opt $cmdp $args]
 589        return [open [concat [list | ] $opt $cmdp $args] w]
 590}
 591
 592proc githook_read {hook_name args} {
 593        set pchook [gitdir hooks $hook_name]
 594        lappend args 2>@1
 595
 596        # On Windows [file executable] might lie so we need to ask
 597        # the shell if the hook is executable.  Yes that's annoying.
 598        #
 599        if {[is_Windows]} {
 600                upvar #0 _sh interp
 601                if {![info exists interp]} {
 602                        set interp [_which sh]
 603                }
 604                if {$interp eq {}} {
 605                        error "hook execution requires sh (not in PATH)"
 606                }
 607
 608                set scr {if test -x "$1";then exec "$@";fi}
 609                set sh_c [list $interp -c $scr $interp $pchook]
 610                return [_open_stdout_stderr [concat $sh_c $args]]
 611        }
 612
 613        if {[file executable $pchook]} {
 614                return [_open_stdout_stderr [concat [list $pchook] $args]]
 615        }
 616
 617        return {}
 618}
 619
 620proc kill_file_process {fd} {
 621        set process [pid $fd]
 622
 623        catch {
 624                if {[is_Windows]} {
 625                        # Use a Cygwin-specific flag to allow killing
 626                        # native Windows processes
 627                        exec kill -f $process
 628                } else {
 629                        exec kill $process
 630                }
 631        }
 632}
 633
 634proc gitattr {path attr default} {
 635        if {[catch {set r [git check-attr $attr -- $path]}]} {
 636                set r unspecified
 637        } else {
 638                set r [join [lrange [split $r :] 2 end] :]
 639                regsub {^ } $r {} r
 640        }
 641        if {$r eq {unspecified}} {
 642                return $default
 643        }
 644        return $r
 645}
 646
 647proc sq {value} {
 648        regsub -all ' $value "'\\''" value
 649        return "'$value'"
 650}
 651
 652proc load_current_branch {} {
 653        global current_branch is_detached
 654
 655        set fd [open [gitdir HEAD] r]
 656        if {[gets $fd ref] < 1} {
 657                set ref {}
 658        }
 659        close $fd
 660
 661        set pfx {ref: refs/heads/}
 662        set len [string length $pfx]
 663        if {[string equal -length $len $pfx $ref]} {
 664                # We're on a branch.  It might not exist.  But
 665                # HEAD looks good enough to be a branch.
 666                #
 667                set current_branch [string range $ref $len end]
 668                set is_detached 0
 669        } else {
 670                # Assume this is a detached head.
 671                #
 672                set current_branch HEAD
 673                set is_detached 1
 674        }
 675}
 676
 677auto_load tk_optionMenu
 678rename tk_optionMenu real__tkOptionMenu
 679proc tk_optionMenu {w varName args} {
 680        set m [eval real__tkOptionMenu $w $varName $args]
 681        $m configure -font font_ui
 682        $w configure -font font_ui
 683        return $m
 684}
 685
 686proc rmsel_tag {text} {
 687        $text tag conf sel \
 688                -background [$text cget -background] \
 689                -foreground [$text cget -foreground] \
 690                -borderwidth 0
 691        $text tag conf in_sel -background lightgray
 692        bind $text <Motion> break
 693        return $text
 694}
 695
 696wm withdraw .
 697set root_exists 0
 698bind . <Visibility> {
 699        bind . <Visibility> {}
 700        set root_exists 1
 701}
 702
 703if {[is_Windows]} {
 704        wm iconbitmap . -default $oguilib/git-gui.ico
 705        set ::tk::AlwaysShowSelection 1
 706        bind . <Control-F2> {console show}
 707
 708        # Spoof an X11 display for SSH
 709        if {![info exists env(DISPLAY)]} {
 710                set env(DISPLAY) :9999
 711        }
 712} else {
 713        catch {
 714                image create photo gitlogo -width 16 -height 16
 715
 716                gitlogo put #33CC33 -to  7  0  9  2
 717                gitlogo put #33CC33 -to  4  2 12  4
 718                gitlogo put #33CC33 -to  7  4  9  6
 719                gitlogo put #CC3333 -to  4  6 12  8
 720                gitlogo put gray26  -to  4  9  6 10
 721                gitlogo put gray26  -to  3 10  6 12
 722                gitlogo put gray26  -to  8  9 13 11
 723                gitlogo put gray26  -to  8 11 10 12
 724                gitlogo put gray26  -to 11 11 13 14
 725                gitlogo put gray26  -to  3 12  5 14
 726                gitlogo put gray26  -to  5 13
 727                gitlogo put gray26  -to 10 13
 728                gitlogo put gray26  -to  4 14 12 15
 729                gitlogo put gray26  -to  5 15 11 16
 730                gitlogo redither
 731
 732                wm iconphoto . -default gitlogo
 733        }
 734}
 735
 736######################################################################
 737##
 738## config defaults
 739
 740set cursor_ptr arrow
 741font create font_ui
 742if {[lsearch -exact [font names] TkDefaultFont] != -1} {
 743        eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
 744        eval [linsert [font actual TkFixedFont] 0 font create font_diff]
 745} else {
 746        font create font_diff -family Courier -size 10
 747        catch {
 748                label .dummy
 749                eval font configure font_ui [font actual [.dummy cget -font]]
 750                destroy .dummy
 751        }
 752}
 753
 754font create font_uiitalic
 755font create font_uibold
 756font create font_diffbold
 757font create font_diffitalic
 758
 759foreach class {Button Checkbutton Entry Label
 760                Labelframe Listbox Message
 761                Radiobutton Spinbox Text} {
 762        option add *$class.font font_ui
 763}
 764if {![is_MacOSX]} {
 765        option add *Menu.font font_ui
 766        option add *Entry.borderWidth 1 startupFile
 767        option add *Entry.relief sunken startupFile
 768        option add *RadioButton.anchor w startupFile
 769}
 770unset class
 771
 772if {[is_Windows] || [is_MacOSX]} {
 773        option add *Menu.tearOff 0
 774}
 775
 776if {[is_MacOSX]} {
 777        set M1B M1
 778        set M1T Cmd
 779} else {
 780        set M1B Control
 781        set M1T Ctrl
 782}
 783
 784proc bind_button3 {w cmd} {
 785        bind $w <Any-Button-3> $cmd
 786        if {[is_MacOSX]} {
 787                # Mac OS X sends Button-2 on right click through three-button mouse,
 788                # or through trackpad right-clicking (two-finger touch + click).
 789                bind $w <Any-Button-2> $cmd
 790                bind $w <Control-Button-1> $cmd
 791        }
 792}
 793
 794proc apply_config {} {
 795        global repo_config font_descs
 796
 797        foreach option $font_descs {
 798                set name [lindex $option 0]
 799                set font [lindex $option 1]
 800                if {[catch {
 801                        set need_weight 1
 802                        foreach {cn cv} $repo_config(gui.$name) {
 803                                if {$cn eq {-weight}} {
 804                                        set need_weight 0
 805                                }
 806                                font configure $font $cn $cv
 807                        }
 808                        if {$need_weight} {
 809                                font configure $font -weight normal
 810                        }
 811                        } err]} {
 812                        error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
 813                }
 814                foreach {cn cv} [font configure $font] {
 815                        font configure ${font}bold $cn $cv
 816                        font configure ${font}italic $cn $cv
 817                }
 818                font configure ${font}bold -weight bold
 819                font configure ${font}italic -slant italic
 820        }
 821
 822        global use_ttk NS
 823        set use_ttk 0
 824        set NS {}
 825        if {$repo_config(gui.usettk)} {
 826                set use_ttk [package vsatisfies [package provide Tk] 8.5]
 827                if {$use_ttk} {
 828                        set NS ttk
 829                        bind [winfo class .] <<ThemeChanged>> [list InitTheme]
 830                        pave_toplevel .
 831                }
 832        }
 833}
 834
 835set default_config(branch.autosetupmerge) true
 836set default_config(merge.tool) {}
 837set default_config(mergetool.keepbackup) true
 838set default_config(merge.diffstat) true
 839set default_config(merge.summary) false
 840set default_config(merge.verbosity) 2
 841set default_config(user.name) {}
 842set default_config(user.email) {}
 843
 844set default_config(gui.encoding) [encoding system]
 845set default_config(gui.matchtrackingbranch) false
 846set default_config(gui.textconv) true
 847set default_config(gui.pruneduringfetch) false
 848set default_config(gui.trustmtime) false
 849set default_config(gui.fastcopyblame) false
 850set default_config(gui.copyblamethreshold) 40
 851set default_config(gui.blamehistoryctx) 7
 852set default_config(gui.diffcontext) 5
 853set default_config(gui.diffopts) {}
 854set default_config(gui.commitmsgwidth) 75
 855set default_config(gui.newbranchtemplate) {}
 856set default_config(gui.spellingdictionary) {}
 857set default_config(gui.fontui) [font configure font_ui]
 858set default_config(gui.fontdiff) [font configure font_diff]
 859# TODO: this option should be added to the git-config documentation
 860set default_config(gui.maxfilesdisplayed) 5000
 861set default_config(gui.usettk) 1
 862set default_config(gui.warndetachedcommit) 1
 863set font_descs {
 864        {fontui   font_ui   {mc "Main Font"}}
 865        {fontdiff font_diff {mc "Diff/Console Font"}}
 866}
 867set default_config(gui.stageuntracked) ask
 868
 869######################################################################
 870##
 871## find git
 872
 873set _git  [_which git]
 874if {$_git eq {}} {
 875        catch {wm withdraw .}
 876        tk_messageBox \
 877                -icon error \
 878                -type ok \
 879                -title [mc "git-gui: fatal error"] \
 880                -message [mc "Cannot find git in PATH."]
 881        exit 1
 882}
 883
 884######################################################################
 885##
 886## version check
 887
 888if {[catch {set _git_version [git --version]} err]} {
 889        catch {wm withdraw .}
 890        tk_messageBox \
 891                -icon error \
 892                -type ok \
 893                -title [mc "git-gui: fatal error"] \
 894                -message "Cannot determine Git version:
 895
 896$err
 897
 898[appname] requires Git 1.5.0 or later."
 899        exit 1
 900}
 901if {![regsub {^git version } $_git_version {} _git_version]} {
 902        catch {wm withdraw .}
 903        tk_messageBox \
 904                -icon error \
 905                -type ok \
 906                -title [mc "git-gui: fatal error"] \
 907                -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 908        exit 1
 909}
 910
 911proc get_trimmed_version {s} {
 912    set r {}
 913    foreach x [split $s -._] {
 914        if {[string is integer -strict $x]} {
 915            lappend r $x
 916        } else {
 917            break
 918        }
 919    }
 920    return [join $r .]
 921}
 922set _real_git_version $_git_version
 923set _git_version [get_trimmed_version $_git_version]
 924
 925if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 926        catch {wm withdraw .}
 927        if {[tk_messageBox \
 928                -icon warning \
 929                -type yesno \
 930                -default no \
 931                -title "[appname]: warning" \
 932                 -message [mc "Git version cannot be determined.
 933
 934%s claims it is version '%s'.
 935
 936%s requires at least Git 1.5.0 or later.
 937
 938Assume '%s' is version 1.5.0?
 939" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 940                set _git_version 1.5.0
 941        } else {
 942                exit 1
 943        }
 944}
 945unset _real_git_version
 946
 947proc git-version {args} {
 948        global _git_version
 949
 950        switch [llength $args] {
 951        0 {
 952                return $_git_version
 953        }
 954
 955        2 {
 956                set op [lindex $args 0]
 957                set vr [lindex $args 1]
 958                set cm [package vcompare $_git_version $vr]
 959                return [expr $cm $op 0]
 960        }
 961
 962        4 {
 963                set type [lindex $args 0]
 964                set name [lindex $args 1]
 965                set parm [lindex $args 2]
 966                set body [lindex $args 3]
 967
 968                if {($type ne {proc} && $type ne {method})} {
 969                        error "Invalid arguments to git-version"
 970                }
 971                if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 972                        error "Last arm of $type $name must be default"
 973                }
 974
 975                foreach {op vr cb} [lrange $body 0 end-2] {
 976                        if {[git-version $op $vr]} {
 977                                return [uplevel [list $type $name $parm $cb]]
 978                        }
 979                }
 980
 981                return [uplevel [list $type $name $parm [lindex $body end]]]
 982        }
 983
 984        default {
 985                error "git-version >= x"
 986        }
 987
 988        }
 989}
 990
 991if {[git-version < 1.5]} {
 992        catch {wm withdraw .}
 993        tk_messageBox \
 994                -icon error \
 995                -type ok \
 996                -title [mc "git-gui: fatal error"] \
 997                -message "[appname] requires Git 1.5.0 or later.
 998
 999You are using [git-version]:
1000
1001[git --version]"
1002        exit 1
1003}
1004
1005######################################################################
1006##
1007## configure our library
1008
1009set idx [file join $oguilib tclIndex]
1010if {[catch {set fd [open $idx r]} err]} {
1011        catch {wm withdraw .}
1012        tk_messageBox \
1013                -icon error \
1014                -type ok \
1015                -title [mc "git-gui: fatal error"] \
1016                -message $err
1017        exit 1
1018}
1019if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
1020        set idx [list]
1021        while {[gets $fd n] >= 0} {
1022                if {$n ne {} && ![string match #* $n]} {
1023                        lappend idx $n
1024                }
1025        }
1026} else {
1027        set idx {}
1028}
1029close $fd
1030
1031if {$idx ne {}} {
1032        set loaded [list]
1033        foreach p $idx {
1034                if {[lsearch -exact $loaded $p] >= 0} continue
1035                source [file join $oguilib $p]
1036                lappend loaded $p
1037        }
1038        unset loaded p
1039} else {
1040        set auto_path [concat [list $oguilib] $auto_path]
1041}
1042unset -nocomplain idx fd
1043
1044######################################################################
1045##
1046## config file parsing
1047
1048git-version proc _parse_config {arr_name args} {
1049        >= 1.5.3 {
1050                upvar $arr_name arr
1051                array unset arr
1052                set buf {}
1053                catch {
1054                        set fd_rc [eval \
1055                                [list git_read config] \
1056                                $args \
1057                                [list --null --list]]
1058                        fconfigure $fd_rc -translation binary
1059                        set buf [read $fd_rc]
1060                        close $fd_rc
1061                }
1062                foreach line [split $buf "\0"] {
1063                        if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1064                                if {[is_many_config $name]} {
1065                                        lappend arr($name) $value
1066                                } else {
1067                                        set arr($name) $value
1068                                }
1069                        } elseif {[regexp {^([^\n]+)$} $line line name]} {
1070                                # no value given, but interpreting them as
1071                                # boolean will be handled as true
1072                                set arr($name) {}
1073                        }
1074                }
1075        }
1076        default {
1077                upvar $arr_name arr
1078                array unset arr
1079                catch {
1080                        set fd_rc [eval [list git_read config --list] $args]
1081                        while {[gets $fd_rc line] >= 0} {
1082                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1083                                        if {[is_many_config $name]} {
1084                                                lappend arr($name) $value
1085                                        } else {
1086                                                set arr($name) $value
1087                                        }
1088                                } elseif {[regexp {^([^=]+)$} $line line name]} {
1089                                        # no value given, but interpreting them as
1090                                        # boolean will be handled as true
1091                                        set arr($name) {}
1092                                }
1093                        }
1094                        close $fd_rc
1095                }
1096        }
1097}
1098
1099proc load_config {include_global} {
1100        global repo_config global_config system_config default_config
1101
1102        if {$include_global} {
1103                _parse_config system_config --system
1104                _parse_config global_config --global
1105        }
1106        _parse_config repo_config
1107
1108        foreach name [array names default_config] {
1109                if {[catch {set v $system_config($name)}]} {
1110                        set system_config($name) $default_config($name)
1111                }
1112        }
1113        foreach name [array names system_config] {
1114                if {[catch {set v $global_config($name)}]} {
1115                        set global_config($name) $system_config($name)
1116                }
1117                if {[catch {set v $repo_config($name)}]} {
1118                        set repo_config($name) $system_config($name)
1119                }
1120        }
1121}
1122
1123######################################################################
1124##
1125## feature option selection
1126
1127if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1128        unset _junk
1129} else {
1130        set subcommand gui
1131}
1132if {$subcommand eq {gui.sh}} {
1133        set subcommand gui
1134}
1135if {$subcommand eq {gui} && [llength $argv] > 0} {
1136        set subcommand [lindex $argv 0]
1137        set argv [lrange $argv 1 end]
1138}
1139
1140enable_option multicommit
1141enable_option branch
1142enable_option transport
1143disable_option bare
1144
1145switch -- $subcommand {
1146browser -
1147blame {
1148        enable_option bare
1149
1150        disable_option multicommit
1151        disable_option branch
1152        disable_option transport
1153}
1154citool {
1155        enable_option singlecommit
1156        enable_option retcode
1157
1158        disable_option multicommit
1159        disable_option branch
1160        disable_option transport
1161
1162        while {[llength $argv] > 0} {
1163                set a [lindex $argv 0]
1164                switch -- $a {
1165                --amend {
1166                        enable_option initialamend
1167                }
1168                --nocommit {
1169                        enable_option nocommit
1170                        enable_option nocommitmsg
1171                }
1172                --commitmsg {
1173                        disable_option nocommitmsg
1174                }
1175                default {
1176                        break
1177                }
1178                }
1179
1180                set argv [lrange $argv 1 end]
1181        }
1182}
1183}
1184
1185######################################################################
1186##
1187## execution environment
1188
1189set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1190
1191# Suggest our implementation of askpass, if none is set
1192if {![info exists env(SSH_ASKPASS)]} {
1193        set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1194}
1195
1196######################################################################
1197##
1198## repository setup
1199
1200set picked 0
1201if {[catch {
1202                set _gitdir $env(GIT_DIR)
1203                set _prefix {}
1204                }]
1205        && [catch {
1206                # beware that from the .git dir this sets _gitdir to .
1207                # and _prefix to the empty string
1208                set _gitdir [git rev-parse --git-dir]
1209                set _prefix [git rev-parse --show-prefix]
1210        } err]} {
1211        load_config 1
1212        apply_config
1213        choose_repository::pick
1214        set picked 1
1215}
1216
1217# we expand the _gitdir when it's just a single dot (i.e. when we're being
1218# run from the .git dir itself) lest the routines to find the worktree
1219# get confused
1220if {$_gitdir eq "."} {
1221        set _gitdir [pwd]
1222}
1223
1224if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1225        catch {set _gitdir [exec cygpath --windows $_gitdir]}
1226}
1227if {![file isdirectory $_gitdir]} {
1228        catch {wm withdraw .}
1229        error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1230        exit 1
1231}
1232# _gitdir exists, so try loading the config
1233load_config 0
1234apply_config
1235
1236# v1.7.0 introduced --show-toplevel to return the canonical work-tree
1237if {[package vsatisfies $_git_version 1.7.0]} {
1238        set _gitworktree [git rev-parse --show-toplevel]
1239} else {
1240        # try to set work tree from environment, core.worktree or use
1241        # cdup to obtain a relative path to the top of the worktree. If
1242        # run from the top, the ./ prefix ensures normalize expands pwd.
1243        if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1244                set _gitworktree [get_config core.worktree]
1245                if {$_gitworktree eq ""} {
1246                        set _gitworktree [file normalize ./[git rev-parse --show-cdup]]
1247                }
1248        }
1249}
1250
1251if {$_prefix ne {}} {
1252        if {$_gitworktree eq {}} {
1253                regsub -all {[^/]+/} $_prefix ../ cdup
1254        } else {
1255                set cdup $_gitworktree
1256        }
1257        if {[catch {cd $cdup} err]} {
1258                catch {wm withdraw .}
1259                error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1260                exit 1
1261        }
1262        set _gitworktree [pwd]
1263        unset cdup
1264} elseif {![is_enabled bare]} {
1265        if {[is_bare]} {
1266                catch {wm withdraw .}
1267                error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1268                exit 1
1269        }
1270        if {$_gitworktree eq {}} {
1271                set _gitworktree [file dirname $_gitdir]
1272        }
1273        if {[catch {cd $_gitworktree} err]} {
1274                catch {wm withdraw .}
1275                error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1276                exit 1
1277        }
1278        set _gitworktree [pwd]
1279}
1280set _reponame [file split [file normalize $_gitdir]]
1281if {[lindex $_reponame end] eq {.git}} {
1282        set _reponame [lindex $_reponame end-1]
1283} else {
1284        set _reponame [lindex $_reponame end]
1285}
1286
1287set env(GIT_DIR) $_gitdir
1288set env(GIT_WORK_TREE) $_gitworktree
1289
1290######################################################################
1291##
1292## global init
1293
1294set current_diff_path {}
1295set current_diff_side {}
1296set diff_actions [list]
1297
1298set HEAD {}
1299set PARENT {}
1300set MERGE_HEAD [list]
1301set commit_type {}
1302set empty_tree {}
1303set current_branch {}
1304set is_detached 0
1305set current_diff_path {}
1306set is_3way_diff 0
1307set is_submodule_diff 0
1308set is_conflict_diff 0
1309set selected_commit_type new
1310set diff_empty_count 0
1311
1312set nullid "0000000000000000000000000000000000000000"
1313set nullid2 "0000000000000000000000000000000000000001"
1314
1315######################################################################
1316##
1317## task management
1318
1319set rescan_active 0
1320set diff_active 0
1321set last_clicked {}
1322
1323set disable_on_lock [list]
1324set index_lock_type none
1325
1326proc lock_index {type} {
1327        global index_lock_type disable_on_lock
1328
1329        if {$index_lock_type eq {none}} {
1330                set index_lock_type $type
1331                foreach w $disable_on_lock {
1332                        uplevel #0 $w disabled
1333                }
1334                return 1
1335        } elseif {$index_lock_type eq "begin-$type"} {
1336                set index_lock_type $type
1337                return 1
1338        }
1339        return 0
1340}
1341
1342proc unlock_index {} {
1343        global index_lock_type disable_on_lock
1344
1345        set index_lock_type none
1346        foreach w $disable_on_lock {
1347                uplevel #0 $w normal
1348        }
1349}
1350
1351######################################################################
1352##
1353## status
1354
1355proc repository_state {ctvar hdvar mhvar} {
1356        global current_branch
1357        upvar $ctvar ct $hdvar hd $mhvar mh
1358
1359        set mh [list]
1360
1361        load_current_branch
1362        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1363                set hd {}
1364                set ct initial
1365                return
1366        }
1367
1368        set merge_head [gitdir MERGE_HEAD]
1369        if {[file exists $merge_head]} {
1370                set ct merge
1371                set fd_mh [open $merge_head r]
1372                while {[gets $fd_mh line] >= 0} {
1373                        lappend mh $line
1374                }
1375                close $fd_mh
1376                return
1377        }
1378
1379        set ct normal
1380}
1381
1382proc PARENT {} {
1383        global PARENT empty_tree
1384
1385        set p [lindex $PARENT 0]
1386        if {$p ne {}} {
1387                return $p
1388        }
1389        if {$empty_tree eq {}} {
1390                set empty_tree [git mktree << {}]
1391        }
1392        return $empty_tree
1393}
1394
1395proc force_amend {} {
1396        global selected_commit_type
1397        global HEAD PARENT MERGE_HEAD commit_type
1398
1399        repository_state newType newHEAD newMERGE_HEAD
1400        set HEAD $newHEAD
1401        set PARENT $newHEAD
1402        set MERGE_HEAD $newMERGE_HEAD
1403        set commit_type $newType
1404
1405        set selected_commit_type amend
1406        do_select_commit_type
1407}
1408
1409proc rescan {after {honor_trustmtime 1}} {
1410        global HEAD PARENT MERGE_HEAD commit_type
1411        global ui_index ui_workdir ui_comm
1412        global rescan_active file_states
1413        global repo_config
1414
1415        if {$rescan_active > 0 || ![lock_index read]} return
1416
1417        repository_state newType newHEAD newMERGE_HEAD
1418        if {[string match amend* $commit_type]
1419                && $newType eq {normal}
1420                && $newHEAD eq $HEAD} {
1421        } else {
1422                set HEAD $newHEAD
1423                set PARENT $newHEAD
1424                set MERGE_HEAD $newMERGE_HEAD
1425                set commit_type $newType
1426        }
1427
1428        array unset file_states
1429
1430        if {!$::GITGUI_BCK_exists &&
1431                (![$ui_comm edit modified]
1432                || [string trim [$ui_comm get 0.0 end]] eq {})} {
1433                if {[string match amend* $commit_type]} {
1434                } elseif {[load_message GITGUI_MSG]} {
1435                } elseif {[run_prepare_commit_msg_hook]} {
1436                } elseif {[load_message MERGE_MSG]} {
1437                } elseif {[load_message SQUASH_MSG]} {
1438                }
1439                $ui_comm edit reset
1440                $ui_comm edit modified false
1441        }
1442
1443        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1444                rescan_stage2 {} $after
1445        } else {
1446                set rescan_active 1
1447                ui_status [mc "Refreshing file status..."]
1448                set fd_rf [git_read update-index \
1449                        -q \
1450                        --unmerged \
1451                        --ignore-missing \
1452                        --refresh \
1453                        ]
1454                fconfigure $fd_rf -blocking 0 -translation binary
1455                fileevent $fd_rf readable \
1456                        [list rescan_stage2 $fd_rf $after]
1457        }
1458}
1459
1460if {[is_Cygwin]} {
1461        set is_git_info_exclude {}
1462        proc have_info_exclude {} {
1463                global is_git_info_exclude
1464
1465                if {$is_git_info_exclude eq {}} {
1466                        if {[catch {exec test -f [gitdir info exclude]}]} {
1467                                set is_git_info_exclude 0
1468                        } else {
1469                                set is_git_info_exclude 1
1470                        }
1471                }
1472                return $is_git_info_exclude
1473        }
1474} else {
1475        proc have_info_exclude {} {
1476                return [file readable [gitdir info exclude]]
1477        }
1478}
1479
1480proc rescan_stage2 {fd after} {
1481        global rescan_active buf_rdi buf_rdf buf_rlo
1482
1483        if {$fd ne {}} {
1484                read $fd
1485                if {![eof $fd]} return
1486                close $fd
1487        }
1488
1489        if {[package vsatisfies $::_git_version 1.6.3]} {
1490                set ls_others [list --exclude-standard]
1491        } else {
1492                set ls_others [list --exclude-per-directory=.gitignore]
1493                if {[have_info_exclude]} {
1494                        lappend ls_others "--exclude-from=[gitdir info exclude]"
1495                }
1496                set user_exclude [get_config core.excludesfile]
1497                if {$user_exclude ne {} && [file readable $user_exclude]} {
1498                        lappend ls_others "--exclude-from=[file normalize $user_exclude]"
1499                }
1500        }
1501
1502        set buf_rdi {}
1503        set buf_rdf {}
1504        set buf_rlo {}
1505
1506        set rescan_active 3
1507        ui_status [mc "Scanning for modified files ..."]
1508        set fd_di [git_read diff-index --cached -z [PARENT]]
1509        set fd_df [git_read diff-files -z]
1510        set fd_lo [eval git_read ls-files --others -z $ls_others]
1511
1512        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1513        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1514        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1515        fileevent $fd_di readable [list read_diff_index $fd_di $after]
1516        fileevent $fd_df readable [list read_diff_files $fd_df $after]
1517        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1518}
1519
1520proc load_message {file} {
1521        global ui_comm
1522
1523        set f [gitdir $file]
1524        if {[file isfile $f]} {
1525                if {[catch {set fd [open $f r]}]} {
1526                        return 0
1527                }
1528                fconfigure $fd -eofchar {}
1529                set content [string trim [read $fd]]
1530                close $fd
1531                regsub -all -line {[ \r\t]+$} $content {} content
1532                $ui_comm delete 0.0 end
1533                $ui_comm insert end $content
1534                return 1
1535        }
1536        return 0
1537}
1538
1539proc run_prepare_commit_msg_hook {} {
1540        global pch_error
1541
1542        # prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1543        # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1544        # empty file but existent file.
1545
1546        set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1547
1548        if {[file isfile [gitdir MERGE_MSG]]} {
1549                set pcm_source "merge"
1550                set fd_mm [open [gitdir MERGE_MSG] r]
1551                puts -nonewline $fd_pcm [read $fd_mm]
1552                close $fd_mm
1553        } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1554                set pcm_source "squash"
1555                set fd_sm [open [gitdir SQUASH_MSG] r]
1556                puts -nonewline $fd_pcm [read $fd_sm]
1557                close $fd_sm
1558        } else {
1559                set pcm_source ""
1560        }
1561
1562        close $fd_pcm
1563
1564        set fd_ph [githook_read prepare-commit-msg \
1565                        [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1566        if {$fd_ph eq {}} {
1567                catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1568                return 0;
1569        }
1570
1571        ui_status [mc "Calling prepare-commit-msg hook..."]
1572        set pch_error {}
1573
1574        fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1575        fileevent $fd_ph readable \
1576                [list prepare_commit_msg_hook_wait $fd_ph]
1577
1578        return 1;
1579}
1580
1581proc prepare_commit_msg_hook_wait {fd_ph} {
1582        global pch_error
1583
1584        append pch_error [read $fd_ph]
1585        fconfigure $fd_ph -blocking 1
1586        if {[eof $fd_ph]} {
1587                if {[catch {close $fd_ph}]} {
1588                        ui_status [mc "Commit declined by prepare-commit-msg hook."]
1589                        hook_failed_popup prepare-commit-msg $pch_error
1590                        catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1591                        exit 1
1592                } else {
1593                        load_message PREPARE_COMMIT_MSG
1594                }
1595                set pch_error {}
1596                catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1597                return
1598        }
1599        fconfigure $fd_ph -blocking 0
1600        catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1601}
1602
1603proc read_diff_index {fd after} {
1604        global buf_rdi
1605
1606        append buf_rdi [read $fd]
1607        set c 0
1608        set n [string length $buf_rdi]
1609        while {$c < $n} {
1610                set z1 [string first "\0" $buf_rdi $c]
1611                if {$z1 == -1} break
1612                incr z1
1613                set z2 [string first "\0" $buf_rdi $z1]
1614                if {$z2 == -1} break
1615
1616                incr c
1617                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1618                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1619                merge_state \
1620                        [encoding convertfrom $p] \
1621                        [lindex $i 4]? \
1622                        [list [lindex $i 0] [lindex $i 2]] \
1623                        [list]
1624                set c $z2
1625                incr c
1626        }
1627        if {$c < $n} {
1628                set buf_rdi [string range $buf_rdi $c end]
1629        } else {
1630                set buf_rdi {}
1631        }
1632
1633        rescan_done $fd buf_rdi $after
1634}
1635
1636proc read_diff_files {fd after} {
1637        global buf_rdf
1638
1639        append buf_rdf [read $fd]
1640        set c 0
1641        set n [string length $buf_rdf]
1642        while {$c < $n} {
1643                set z1 [string first "\0" $buf_rdf $c]
1644                if {$z1 == -1} break
1645                incr z1
1646                set z2 [string first "\0" $buf_rdf $z1]
1647                if {$z2 == -1} break
1648
1649                incr c
1650                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1651                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1652                merge_state \
1653                        [encoding convertfrom $p] \
1654                        ?[lindex $i 4] \
1655                        [list] \
1656                        [list [lindex $i 0] [lindex $i 2]]
1657                set c $z2
1658                incr c
1659        }
1660        if {$c < $n} {
1661                set buf_rdf [string range $buf_rdf $c end]
1662        } else {
1663                set buf_rdf {}
1664        }
1665
1666        rescan_done $fd buf_rdf $after
1667}
1668
1669proc read_ls_others {fd after} {
1670        global buf_rlo
1671
1672        append buf_rlo [read $fd]
1673        set pck [split $buf_rlo "\0"]
1674        set buf_rlo [lindex $pck end]
1675        foreach p [lrange $pck 0 end-1] {
1676                set p [encoding convertfrom $p]
1677                if {[string index $p end] eq {/}} {
1678                        set p [string range $p 0 end-1]
1679                }
1680                merge_state $p ?O
1681        }
1682        rescan_done $fd buf_rlo $after
1683}
1684
1685proc rescan_done {fd buf after} {
1686        global rescan_active current_diff_path
1687        global file_states repo_config
1688        upvar $buf to_clear
1689
1690        if {![eof $fd]} return
1691        set to_clear {}
1692        close $fd
1693        if {[incr rescan_active -1] > 0} return
1694
1695        prune_selection
1696        unlock_index
1697        display_all_files
1698        if {$current_diff_path ne {}} { reshow_diff $after }
1699        if {$current_diff_path eq {}} { select_first_diff $after }
1700}
1701
1702proc prune_selection {} {
1703        global file_states selected_paths
1704
1705        foreach path [array names selected_paths] {
1706                if {[catch {set still_here $file_states($path)}]} {
1707                        unset selected_paths($path)
1708                }
1709        }
1710}
1711
1712######################################################################
1713##
1714## ui helpers
1715
1716proc mapicon {w state path} {
1717        global all_icons
1718
1719        if {[catch {set r $all_icons($state$w)}]} {
1720                puts "error: no icon for $w state={$state} $path"
1721                return file_plain
1722        }
1723        return $r
1724}
1725
1726proc mapdesc {state path} {
1727        global all_descs
1728
1729        if {[catch {set r $all_descs($state)}]} {
1730                puts "error: no desc for state={$state} $path"
1731                return $state
1732        }
1733        return $r
1734}
1735
1736proc ui_status {msg} {
1737        global main_status
1738        if {[info exists main_status]} {
1739                $main_status show $msg
1740        }
1741}
1742
1743proc ui_ready {{test {}}} {
1744        global main_status
1745        if {[info exists main_status]} {
1746                $main_status show [mc "Ready."] $test
1747        }
1748}
1749
1750proc escape_path {path} {
1751        regsub -all {\\} $path "\\\\" path
1752        regsub -all "\n" $path "\\n" path
1753        return $path
1754}
1755
1756proc short_path {path} {
1757        return [escape_path [lindex [file split $path] end]]
1758}
1759
1760set next_icon_id 0
1761set null_sha1 [string repeat 0 40]
1762
1763proc merge_state {path new_state {head_info {}} {index_info {}}} {
1764        global file_states next_icon_id null_sha1
1765
1766        set s0 [string index $new_state 0]
1767        set s1 [string index $new_state 1]
1768
1769        if {[catch {set info $file_states($path)}]} {
1770                set state __
1771                set icon n[incr next_icon_id]
1772        } else {
1773                set state [lindex $info 0]
1774                set icon [lindex $info 1]
1775                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1776                if {$index_info eq {}} {set index_info [lindex $info 3]}
1777        }
1778
1779        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1780        elseif {$s0 eq {_}} {set s0 _}
1781
1782        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1783        elseif {$s1 eq {_}} {set s1 _}
1784
1785        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1786                set head_info [list 0 $null_sha1]
1787        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1788                && $head_info eq {}} {
1789                set head_info $index_info
1790        } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1791                set index_info $head_info
1792                set head_info {}
1793        }
1794
1795        set file_states($path) [list $s0$s1 $icon \
1796                $head_info $index_info \
1797                ]
1798        return $state
1799}
1800
1801proc display_file_helper {w path icon_name old_m new_m} {
1802        global file_lists
1803
1804        if {$new_m eq {_}} {
1805                set lno [lsearch -sorted -exact $file_lists($w) $path]
1806                if {$lno >= 0} {
1807                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1808                        incr lno
1809                        $w conf -state normal
1810                        $w delete $lno.0 [expr {$lno + 1}].0
1811                        $w conf -state disabled
1812                }
1813        } elseif {$old_m eq {_} && $new_m ne {_}} {
1814                lappend file_lists($w) $path
1815                set file_lists($w) [lsort -unique $file_lists($w)]
1816                set lno [lsearch -sorted -exact $file_lists($w) $path]
1817                incr lno
1818                $w conf -state normal
1819                $w image create $lno.0 \
1820                        -align center -padx 5 -pady 1 \
1821                        -name $icon_name \
1822                        -image [mapicon $w $new_m $path]
1823                $w insert $lno.1 "[escape_path $path]\n"
1824                $w conf -state disabled
1825        } elseif {$old_m ne $new_m} {
1826                $w conf -state normal
1827                $w image conf $icon_name -image [mapicon $w $new_m $path]
1828                $w conf -state disabled
1829        }
1830}
1831
1832proc display_file {path state} {
1833        global file_states selected_paths
1834        global ui_index ui_workdir
1835
1836        set old_m [merge_state $path $state]
1837        set s $file_states($path)
1838        set new_m [lindex $s 0]
1839        set icon_name [lindex $s 1]
1840
1841        set o [string index $old_m 0]
1842        set n [string index $new_m 0]
1843        if {$o eq {U}} {
1844                set o _
1845        }
1846        if {$n eq {U}} {
1847                set n _
1848        }
1849        display_file_helper     $ui_index $path $icon_name $o $n
1850
1851        if {[string index $old_m 0] eq {U}} {
1852                set o U
1853        } else {
1854                set o [string index $old_m 1]
1855        }
1856        if {[string index $new_m 0] eq {U}} {
1857                set n U
1858        } else {
1859                set n [string index $new_m 1]
1860        }
1861        display_file_helper     $ui_workdir $path $icon_name $o $n
1862
1863        if {$new_m eq {__}} {
1864                unset file_states($path)
1865                catch {unset selected_paths($path)}
1866        }
1867}
1868
1869proc display_all_files_helper {w path icon_name m} {
1870        global file_lists
1871
1872        lappend file_lists($w) $path
1873        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1874        $w image create end \
1875                -align center -padx 5 -pady 1 \
1876                -name $icon_name \
1877                -image [mapicon $w $m $path]
1878        $w insert end "[escape_path $path]\n"
1879}
1880
1881set files_warning 0
1882proc display_all_files {} {
1883        global ui_index ui_workdir
1884        global file_states file_lists
1885        global last_clicked
1886        global files_warning
1887
1888        $ui_index conf -state normal
1889        $ui_workdir conf -state normal
1890
1891        $ui_index delete 0.0 end
1892        $ui_workdir delete 0.0 end
1893        set last_clicked {}
1894
1895        set file_lists($ui_index) [list]
1896        set file_lists($ui_workdir) [list]
1897
1898        set to_display [lsort [array names file_states]]
1899        set display_limit [get_config gui.maxfilesdisplayed]
1900        if {[llength $to_display] > $display_limit} {
1901                if {!$files_warning} {
1902                        # do not repeatedly warn:
1903                        set files_warning 1
1904                        info_popup [mc "Displaying only %s of %s files." \
1905                                $display_limit [llength $to_display]]
1906                }
1907                set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1908        }
1909        foreach path $to_display {
1910                set s $file_states($path)
1911                set m [lindex $s 0]
1912                set icon_name [lindex $s 1]
1913
1914                set s [string index $m 0]
1915                if {$s ne {U} && $s ne {_}} {
1916                        display_all_files_helper $ui_index $path \
1917                                $icon_name $s
1918                }
1919
1920                if {[string index $m 0] eq {U}} {
1921                        set s U
1922                } else {
1923                        set s [string index $m 1]
1924                }
1925                if {$s ne {_}} {
1926                        display_all_files_helper $ui_workdir $path \
1927                                $icon_name $s
1928                }
1929        }
1930
1931        $ui_index conf -state disabled
1932        $ui_workdir conf -state disabled
1933}
1934
1935######################################################################
1936##
1937## icons
1938
1939set filemask {
1940#define mask_width 14
1941#define mask_height 15
1942static unsigned char mask_bits[] = {
1943   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1944   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1945   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1946}
1947
1948image create bitmap file_plain -background white -foreground black -data {
1949#define plain_width 14
1950#define plain_height 15
1951static unsigned char plain_bits[] = {
1952   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1953   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1954   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1955} -maskdata $filemask
1956
1957image create bitmap file_mod -background white -foreground blue -data {
1958#define mod_width 14
1959#define mod_height 15
1960static unsigned char mod_bits[] = {
1961   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1962   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1963   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1964} -maskdata $filemask
1965
1966image create bitmap file_fulltick -background white -foreground "#007000" -data {
1967#define file_fulltick_width 14
1968#define file_fulltick_height 15
1969static unsigned char file_fulltick_bits[] = {
1970   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1971   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1972   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1973} -maskdata $filemask
1974
1975image create bitmap file_question -background white -foreground black -data {
1976#define file_question_width 14
1977#define file_question_height 15
1978static unsigned char file_question_bits[] = {
1979   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1980   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1981   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1982} -maskdata $filemask
1983
1984image create bitmap file_removed -background white -foreground red -data {
1985#define file_removed_width 14
1986#define file_removed_height 15
1987static unsigned char file_removed_bits[] = {
1988   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1989   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1990   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1991} -maskdata $filemask
1992
1993image create bitmap file_merge -background white -foreground blue -data {
1994#define file_merge_width 14
1995#define file_merge_height 15
1996static unsigned char file_merge_bits[] = {
1997   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1998   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1999   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2000} -maskdata $filemask
2001
2002image create bitmap file_statechange -background white -foreground green -data {
2003#define file_statechange_width 14
2004#define file_statechange_height 15
2005static unsigned char file_statechange_bits[] = {
2006   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2007   0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2008   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2009} -maskdata $filemask
2010
2011set ui_index .vpane.files.index.list
2012set ui_workdir .vpane.files.workdir.list
2013
2014set all_icons(_$ui_index)   file_plain
2015set all_icons(A$ui_index)   file_plain
2016set all_icons(M$ui_index)   file_fulltick
2017set all_icons(D$ui_index)   file_removed
2018set all_icons(U$ui_index)   file_merge
2019set all_icons(T$ui_index)   file_statechange
2020
2021set all_icons(_$ui_workdir) file_plain
2022set all_icons(M$ui_workdir) file_mod
2023set all_icons(D$ui_workdir) file_question
2024set all_icons(U$ui_workdir) file_merge
2025set all_icons(O$ui_workdir) file_plain
2026set all_icons(T$ui_workdir) file_statechange
2027
2028set max_status_desc 0
2029foreach i {
2030                {__ {mc "Unmodified"}}
2031
2032                {_M {mc "Modified, not staged"}}
2033                {M_ {mc "Staged for commit"}}
2034                {MM {mc "Portions staged for commit"}}
2035                {MD {mc "Staged for commit, missing"}}
2036
2037                {_T {mc "File type changed, not staged"}}
2038                {MT {mc "File type changed, old type staged for commit"}}
2039                {AT {mc "File type changed, old type staged for commit"}}
2040                {T_ {mc "File type changed, staged"}}
2041                {TM {mc "File type change staged, modification not staged"}}
2042                {TD {mc "File type change staged, file missing"}}
2043
2044                {_O {mc "Untracked, not staged"}}
2045                {A_ {mc "Staged for commit"}}
2046                {AM {mc "Portions staged for commit"}}
2047                {AD {mc "Staged for commit, missing"}}
2048
2049                {_D {mc "Missing"}}
2050                {D_ {mc "Staged for removal"}}
2051                {DO {mc "Staged for removal, still present"}}
2052
2053                {_U {mc "Requires merge resolution"}}
2054                {U_ {mc "Requires merge resolution"}}
2055                {UU {mc "Requires merge resolution"}}
2056                {UM {mc "Requires merge resolution"}}
2057                {UD {mc "Requires merge resolution"}}
2058                {UT {mc "Requires merge resolution"}}
2059        } {
2060        set text [eval [lindex $i 1]]
2061        if {$max_status_desc < [string length $text]} {
2062                set max_status_desc [string length $text]
2063        }
2064        set all_descs([lindex $i 0]) $text
2065}
2066unset i
2067
2068######################################################################
2069##
2070## util
2071
2072proc scrollbar2many {list mode args} {
2073        foreach w $list {eval $w $mode $args}
2074}
2075
2076proc many2scrollbar {list mode sb top bottom} {
2077        $sb set $top $bottom
2078        foreach w $list {$w $mode moveto $top}
2079}
2080
2081proc incr_font_size {font {amt 1}} {
2082        set sz [font configure $font -size]
2083        incr sz $amt
2084        font configure $font -size $sz
2085        font configure ${font}bold -size $sz
2086        font configure ${font}italic -size $sz
2087}
2088
2089######################################################################
2090##
2091## ui commands
2092
2093set starting_gitk_msg [mc "Starting gitk... please wait..."]
2094
2095proc do_gitk {revs {is_submodule false}} {
2096        global current_diff_path file_states current_diff_side ui_index
2097        global _gitdir _gitworktree
2098
2099        # -- Always start gitk through whatever we were loaded with.  This
2100        #    lets us bypass using shell process on Windows systems.
2101        #
2102        set exe [_which gitk -script]
2103        set cmd [list [info nameofexecutable] $exe]
2104        if {$exe eq {}} {
2105                error_popup [mc "Couldn't find gitk in PATH"]
2106        } else {
2107                global env
2108
2109                set pwd [pwd]
2110
2111                if {!$is_submodule} {
2112                        if {![is_bare]} {
2113                                cd $_gitworktree
2114                        }
2115                } else {
2116                        cd $current_diff_path
2117                        if {$revs eq {--}} {
2118                                set s $file_states($current_diff_path)
2119                                set old_sha1 {}
2120                                set new_sha1 {}
2121                                switch -glob -- [lindex $s 0] {
2122                                M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2123                                _M { set old_sha1 [lindex [lindex $s 3] 1] }
2124                                MM {
2125                                        if {$current_diff_side eq $ui_index} {
2126                                                set old_sha1 [lindex [lindex $s 2] 1]
2127                                                set new_sha1 [lindex [lindex $s 3] 1]
2128                                        } else {
2129                                                set old_sha1 [lindex [lindex $s 3] 1]
2130                                        }
2131                                }
2132                                }
2133                                set revs $old_sha1...$new_sha1
2134                        }
2135                        # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2136                        # we've been using for the main repository, so unset them.
2137                        # TODO we could make life easier (start up faster?) for gitk
2138                        # by setting these to the appropriate values to allow gitk
2139                        # to skip the heuristics to find their proper value
2140                        unset env(GIT_DIR)
2141                        unset env(GIT_WORK_TREE)
2142                }
2143                eval exec $cmd $revs "--" "--" &
2144
2145                set env(GIT_DIR) $_gitdir
2146                set env(GIT_WORK_TREE) $_gitworktree
2147                cd $pwd
2148
2149                ui_status $::starting_gitk_msg
2150                after 10000 {
2151                        ui_ready $starting_gitk_msg
2152                }
2153        }
2154}
2155
2156proc do_git_gui {} {
2157        global current_diff_path
2158
2159        # -- Always start git gui through whatever we were loaded with.  This
2160        #    lets us bypass using shell process on Windows systems.
2161        #
2162        set exe [list [_which git]]
2163        if {$exe eq {}} {
2164                error_popup [mc "Couldn't find git gui in PATH"]
2165        } else {
2166                global env
2167                global _gitdir _gitworktree
2168
2169                # see note in do_gitk about unsetting these vars when
2170                # running tools in a submodule
2171                unset env(GIT_DIR)
2172                unset env(GIT_WORK_TREE)
2173
2174                set pwd [pwd]
2175                cd $current_diff_path
2176
2177                eval exec $exe gui &
2178
2179                set env(GIT_DIR) $_gitdir
2180                set env(GIT_WORK_TREE) $_gitworktree
2181                cd $pwd
2182
2183                ui_status $::starting_gitk_msg
2184                after 10000 {
2185                        ui_ready $starting_gitk_msg
2186                }
2187        }
2188}
2189
2190proc do_explore {} {
2191        global _gitworktree
2192        set explorer {}
2193        if {[is_Cygwin] || [is_Windows]} {
2194                set explorer "explorer.exe"
2195        } elseif {[is_MacOSX]} {
2196                set explorer "open"
2197        } else {
2198                # freedesktop.org-conforming system is our best shot
2199                set explorer "xdg-open"
2200        }
2201        eval exec $explorer [list [file nativename $_gitworktree]] &
2202}
2203
2204set is_quitting 0
2205set ret_code    1
2206
2207proc terminate_me {win} {
2208        global ret_code
2209        if {$win ne {.}} return
2210        exit $ret_code
2211}
2212
2213proc do_quit {{rc {1}}} {
2214        global ui_comm is_quitting repo_config commit_type
2215        global GITGUI_BCK_exists GITGUI_BCK_i
2216        global ui_comm_spell
2217        global ret_code use_ttk
2218
2219        if {$is_quitting} return
2220        set is_quitting 1
2221
2222        if {[winfo exists $ui_comm]} {
2223                # -- Stash our current commit buffer.
2224                #
2225                set save [gitdir GITGUI_MSG]
2226                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2227                        file rename -force [gitdir GITGUI_BCK] $save
2228                        set GITGUI_BCK_exists 0
2229                } else {
2230                        set msg [string trim [$ui_comm get 0.0 end]]
2231                        regsub -all -line {[ \r\t]+$} $msg {} msg
2232                        if {(![string match amend* $commit_type]
2233                                || [$ui_comm edit modified])
2234                                && $msg ne {}} {
2235                                catch {
2236                                        set fd [open $save w]
2237                                        puts -nonewline $fd $msg
2238                                        close $fd
2239                                }
2240                        } else {
2241                                catch {file delete $save}
2242                        }
2243                }
2244
2245                # -- Cancel our spellchecker if its running.
2246                #
2247                if {[info exists ui_comm_spell]} {
2248                        $ui_comm_spell stop
2249                }
2250
2251                # -- Remove our editor backup, its not needed.
2252                #
2253                after cancel $GITGUI_BCK_i
2254                if {$GITGUI_BCK_exists} {
2255                        catch {file delete [gitdir GITGUI_BCK]}
2256                }
2257
2258                # -- Stash our current window geometry into this repository.
2259                #
2260                set cfg_wmstate [wm state .]
2261                if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2262                        set rc_wmstate {}
2263                }
2264                if {$cfg_wmstate ne $rc_wmstate} {
2265                        catch {git config gui.wmstate $cfg_wmstate}
2266                }
2267                if {$cfg_wmstate eq {zoomed}} {
2268                        # on Windows wm geometry will lie about window
2269                        # position (but not size) when window is zoomed
2270                        # restore the window before querying wm geometry
2271                        wm state . normal
2272                }
2273                set cfg_geometry [list]
2274                lappend cfg_geometry [wm geometry .]
2275                if {$use_ttk} {
2276                        lappend cfg_geometry [.vpane sashpos 0]
2277                        lappend cfg_geometry [.vpane.files sashpos 0]
2278                } else {
2279                        lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2280                        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2281                }
2282                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2283                        set rc_geometry {}
2284                }
2285                if {$cfg_geometry ne $rc_geometry} {
2286                        catch {git config gui.geometry $cfg_geometry}
2287                }
2288        }
2289
2290        set ret_code $rc
2291
2292        # Briefly enable send again, working around Tk bug
2293        # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2294        tk appname [appname]
2295
2296        destroy .
2297}
2298
2299proc do_rescan {} {
2300        rescan ui_ready
2301}
2302
2303proc ui_do_rescan {} {
2304        rescan {force_first_diff ui_ready}
2305}
2306
2307proc do_commit {} {
2308        commit_tree
2309}
2310
2311proc next_diff {{after {}}} {
2312        global next_diff_p next_diff_w next_diff_i
2313        show_diff $next_diff_p $next_diff_w {} {} $after
2314}
2315
2316proc find_anchor_pos {lst name} {
2317        set lid [lsearch -sorted -exact $lst $name]
2318
2319        if {$lid == -1} {
2320                set lid 0
2321                foreach lname $lst {
2322                        if {$lname >= $name} break
2323                        incr lid
2324                }
2325        }
2326
2327        return $lid
2328}
2329
2330proc find_file_from {flist idx delta path mmask} {
2331        global file_states
2332
2333        set len [llength $flist]
2334        while {$idx >= 0 && $idx < $len} {
2335                set name [lindex $flist $idx]
2336
2337                if {$name ne $path && [info exists file_states($name)]} {
2338                        set state [lindex $file_states($name) 0]
2339
2340                        if {$mmask eq {} || [regexp $mmask $state]} {
2341                                return $idx
2342                        }
2343                }
2344
2345                incr idx $delta
2346        }
2347
2348        return {}
2349}
2350
2351proc find_next_diff {w path {lno {}} {mmask {}}} {
2352        global next_diff_p next_diff_w next_diff_i
2353        global file_lists ui_index ui_workdir
2354
2355        set flist $file_lists($w)
2356        if {$lno eq {}} {
2357                set lno [find_anchor_pos $flist $path]
2358        } else {
2359                incr lno -1
2360        }
2361
2362        if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2363                if {$w eq $ui_index} {
2364                        set mmask "^$mmask"
2365                } else {
2366                        set mmask "$mmask\$"
2367                }
2368        }
2369
2370        set idx [find_file_from $flist $lno 1 $path $mmask]
2371        if {$idx eq {}} {
2372                incr lno -1
2373                set idx [find_file_from $flist $lno -1 $path $mmask]
2374        }
2375
2376        if {$idx ne {}} {
2377                set next_diff_w $w
2378                set next_diff_p [lindex $flist $idx]
2379                set next_diff_i [expr {$idx+1}]
2380                return 1
2381        } else {
2382                return 0
2383        }
2384}
2385
2386proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2387        global current_diff_path
2388
2389        if {$path ne $current_diff_path} {
2390                return {}
2391        } elseif {[find_next_diff $w $path $lno $mmask]} {
2392                return {next_diff;}
2393        } else {
2394                return {reshow_diff;}
2395        }
2396}
2397
2398proc select_first_diff {after} {
2399        global ui_workdir
2400
2401        if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2402            [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2403                next_diff $after
2404        } else {
2405                uplevel #0 $after
2406        }
2407}
2408
2409proc force_first_diff {after} {
2410        global ui_workdir current_diff_path file_states
2411
2412        if {[info exists file_states($current_diff_path)]} {
2413                set state [lindex $file_states($current_diff_path) 0]
2414        } else {
2415                set state {OO}
2416        }
2417
2418        set reselect 0
2419        if {[string first {U} $state] >= 0} {
2420                # Already a conflict, do nothing
2421        } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2422                set reselect 1
2423        } elseif {[string index $state 1] ne {O}} {
2424                # Already a diff & no conflicts, do nothing
2425        } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2426                set reselect 1
2427        }
2428
2429        if {$reselect} {
2430                next_diff $after
2431        } else {
2432                uplevel #0 $after
2433        }
2434}
2435
2436proc toggle_or_diff {w x y} {
2437        global file_states file_lists current_diff_path ui_index ui_workdir
2438        global last_clicked selected_paths
2439
2440        set pos [split [$w index @$x,$y] .]
2441        set lno [lindex $pos 0]
2442        set col [lindex $pos 1]
2443        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2444        if {$path eq {}} {
2445                set last_clicked {}
2446                return
2447        }
2448
2449        set last_clicked [list $w $lno]
2450        array unset selected_paths
2451        $ui_index tag remove in_sel 0.0 end
2452        $ui_workdir tag remove in_sel 0.0 end
2453
2454        # Determine the state of the file
2455        if {[info exists file_states($path)]} {
2456                set state [lindex $file_states($path) 0]
2457        } else {
2458                set state {__}
2459        }
2460
2461        # Restage the file, or simply show the diff
2462        if {$col == 0 && $y > 1} {
2463                # Conflicts need special handling
2464                if {[string first {U} $state] >= 0} {
2465                        # $w must always be $ui_workdir, but...
2466                        if {$w ne $ui_workdir} { set lno {} }
2467                        merge_stage_workdir $path $lno
2468                        return
2469                }
2470
2471                if {[string index $state 1] eq {O}} {
2472                        set mmask {}
2473                } else {
2474                        set mmask {[^O]}
2475                }
2476
2477                set after [next_diff_after_action $w $path $lno $mmask]
2478
2479                if {$w eq $ui_index} {
2480                        update_indexinfo \
2481                                "Unstaging [short_path $path] from commit" \
2482                                [list $path] \
2483                                [concat $after [list ui_ready]]
2484                } elseif {$w eq $ui_workdir} {
2485                        update_index \
2486                                "Adding [short_path $path]" \
2487                                [list $path] \
2488                                [concat $after [list ui_ready]]
2489                }
2490        } else {
2491                set selected_paths($path) 1
2492                show_diff $path $w $lno
2493        }
2494}
2495
2496proc add_one_to_selection {w x y} {
2497        global file_lists last_clicked selected_paths
2498
2499        set lno [lindex [split [$w index @$x,$y] .] 0]
2500        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2501        if {$path eq {}} {
2502                set last_clicked {}
2503                return
2504        }
2505
2506        if {$last_clicked ne {}
2507                && [lindex $last_clicked 0] ne $w} {
2508                array unset selected_paths
2509                [lindex $last_clicked 0] tag remove in_sel 0.0 end
2510        }
2511
2512        set last_clicked [list $w $lno]
2513        if {[catch {set in_sel $selected_paths($path)}]} {
2514                set in_sel 0
2515        }
2516        if {$in_sel} {
2517                unset selected_paths($path)
2518                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2519        } else {
2520                set selected_paths($path) 1
2521                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2522        }
2523}
2524
2525proc add_range_to_selection {w x y} {
2526        global file_lists last_clicked selected_paths
2527
2528        if {[lindex $last_clicked 0] ne $w} {
2529                toggle_or_diff $w $x $y
2530                return
2531        }
2532
2533        set lno [lindex [split [$w index @$x,$y] .] 0]
2534        set lc [lindex $last_clicked 1]
2535        if {$lc < $lno} {
2536                set begin $lc
2537                set end $lno
2538        } else {
2539                set begin $lno
2540                set end $lc
2541        }
2542
2543        foreach path [lrange $file_lists($w) \
2544                [expr {$begin - 1}] \
2545                [expr {$end - 1}]] {
2546                set selected_paths($path) 1
2547        }
2548        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2549}
2550
2551proc show_more_context {} {
2552        global repo_config
2553        if {$repo_config(gui.diffcontext) < 99} {
2554                incr repo_config(gui.diffcontext)
2555                reshow_diff
2556        }
2557}
2558
2559proc show_less_context {} {
2560        global repo_config
2561        if {$repo_config(gui.diffcontext) > 1} {
2562                incr repo_config(gui.diffcontext) -1
2563                reshow_diff
2564        }
2565}
2566
2567######################################################################
2568##
2569## ui construction
2570
2571set ui_comm {}
2572
2573# -- Menu Bar
2574#
2575menu .mbar -tearoff 0
2576if {[is_MacOSX]} {
2577        # -- Apple Menu (Mac OS X only)
2578        #
2579        .mbar add cascade -label Apple -menu .mbar.apple
2580        menu .mbar.apple
2581}
2582.mbar add cascade -label [mc Repository] -menu .mbar.repository
2583.mbar add cascade -label [mc Edit] -menu .mbar.edit
2584if {[is_enabled branch]} {
2585        .mbar add cascade -label [mc Branch] -menu .mbar.branch
2586}
2587if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2588        .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2589}
2590if {[is_enabled transport]} {
2591        .mbar add cascade -label [mc Merge] -menu .mbar.merge
2592        .mbar add cascade -label [mc Remote] -menu .mbar.remote
2593}
2594if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2595        .mbar add cascade -label [mc Tools] -menu .mbar.tools
2596}
2597
2598# -- Repository Menu
2599#
2600menu .mbar.repository
2601
2602if {![is_bare]} {
2603        .mbar.repository add command \
2604                -label [mc "Explore Working Copy"] \
2605                -command {do_explore}
2606        .mbar.repository add separator
2607}
2608
2609.mbar.repository add command \
2610        -label [mc "Browse Current Branch's Files"] \
2611        -command {browser::new $current_branch}
2612set ui_browse_current [.mbar.repository index last]
2613.mbar.repository add command \
2614        -label [mc "Browse Branch Files..."] \
2615        -command browser_open::dialog
2616.mbar.repository add separator
2617
2618.mbar.repository add command \
2619        -label [mc "Visualize Current Branch's History"] \
2620        -command {do_gitk $current_branch}
2621set ui_visualize_current [.mbar.repository index last]
2622.mbar.repository add command \
2623        -label [mc "Visualize All Branch History"] \
2624        -command {do_gitk --all}
2625.mbar.repository add separator
2626
2627proc current_branch_write {args} {
2628        global current_branch
2629        .mbar.repository entryconf $::ui_browse_current \
2630                -label [mc "Browse %s's Files" $current_branch]
2631        .mbar.repository entryconf $::ui_visualize_current \
2632                -label [mc "Visualize %s's History" $current_branch]
2633}
2634trace add variable current_branch write current_branch_write
2635
2636if {[is_enabled multicommit]} {
2637        .mbar.repository add command -label [mc "Database Statistics"] \
2638                -command do_stats
2639
2640        .mbar.repository add command -label [mc "Compress Database"] \
2641                -command do_gc
2642
2643        .mbar.repository add command -label [mc "Verify Database"] \
2644                -command do_fsck_objects
2645
2646        .mbar.repository add separator
2647
2648        if {[is_Cygwin]} {
2649                .mbar.repository add command \
2650                        -label [mc "Create Desktop Icon"] \
2651                        -command do_cygwin_shortcut
2652        } elseif {[is_Windows]} {
2653                .mbar.repository add command \
2654                        -label [mc "Create Desktop Icon"] \
2655                        -command do_windows_shortcut
2656        } elseif {[is_MacOSX]} {
2657                .mbar.repository add command \
2658                        -label [mc "Create Desktop Icon"] \
2659                        -command do_macosx_app
2660        }
2661}
2662
2663if {[is_MacOSX]} {
2664        proc ::tk::mac::Quit {args} { do_quit }
2665} else {
2666        .mbar.repository add command -label [mc Quit] \
2667                -command do_quit \
2668                -accelerator $M1T-Q
2669}
2670
2671# -- Edit Menu
2672#
2673menu .mbar.edit
2674.mbar.edit add command -label [mc Undo] \
2675        -command {catch {[focus] edit undo}} \
2676        -accelerator $M1T-Z
2677.mbar.edit add command -label [mc Redo] \
2678        -command {catch {[focus] edit redo}} \
2679        -accelerator $M1T-Y
2680.mbar.edit add separator
2681.mbar.edit add command -label [mc Cut] \
2682        -command {catch {tk_textCut [focus]}} \
2683        -accelerator $M1T-X
2684.mbar.edit add command -label [mc Copy] \
2685        -command {catch {tk_textCopy [focus]}} \
2686        -accelerator $M1T-C
2687.mbar.edit add command -label [mc Paste] \
2688        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2689        -accelerator $M1T-V
2690.mbar.edit add command -label [mc Delete] \
2691        -command {catch {[focus] delete sel.first sel.last}} \
2692        -accelerator Del
2693.mbar.edit add separator
2694.mbar.edit add command -label [mc "Select All"] \
2695        -command {catch {[focus] tag add sel 0.0 end}} \
2696        -accelerator $M1T-A
2697
2698# -- Branch Menu
2699#
2700if {[is_enabled branch]} {
2701        menu .mbar.branch
2702
2703        .mbar.branch add command -label [mc "Create..."] \
2704                -command branch_create::dialog \
2705                -accelerator $M1T-N
2706        lappend disable_on_lock [list .mbar.branch entryconf \
2707                [.mbar.branch index last] -state]
2708
2709        .mbar.branch add command -label [mc "Checkout..."] \
2710                -command branch_checkout::dialog \
2711                -accelerator $M1T-O
2712        lappend disable_on_lock [list .mbar.branch entryconf \
2713                [.mbar.branch index last] -state]
2714
2715        .mbar.branch add command -label [mc "Rename..."] \
2716                -command branch_rename::dialog
2717        lappend disable_on_lock [list .mbar.branch entryconf \
2718                [.mbar.branch index last] -state]
2719
2720        .mbar.branch add command -label [mc "Delete..."] \
2721                -command branch_delete::dialog
2722        lappend disable_on_lock [list .mbar.branch entryconf \
2723                [.mbar.branch index last] -state]
2724
2725        .mbar.branch add command -label [mc "Reset..."] \
2726                -command merge::reset_hard
2727        lappend disable_on_lock [list .mbar.branch entryconf \
2728                [.mbar.branch index last] -state]
2729}
2730
2731# -- Commit Menu
2732#
2733proc commit_btn_caption {} {
2734        if {[is_enabled nocommit]} {
2735                return [mc "Done"]
2736        } else {
2737                return [mc Commit@@verb]
2738        }
2739}
2740
2741if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2742        menu .mbar.commit
2743
2744        if {![is_enabled nocommit]} {
2745                .mbar.commit add radiobutton \
2746                        -label [mc "New Commit"] \
2747                        -command do_select_commit_type \
2748                        -variable selected_commit_type \
2749                        -value new
2750                lappend disable_on_lock \
2751                        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2752
2753                .mbar.commit add radiobutton \
2754                        -label [mc "Amend Last Commit"] \
2755                        -command do_select_commit_type \
2756                        -variable selected_commit_type \
2757                        -value amend
2758                lappend disable_on_lock \
2759                        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2760
2761                .mbar.commit add separator
2762        }
2763
2764        .mbar.commit add command -label [mc Rescan] \
2765                -command ui_do_rescan \
2766                -accelerator F5
2767        lappend disable_on_lock \
2768                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2769
2770        .mbar.commit add command -label [mc "Stage To Commit"] \
2771                -command do_add_selection \
2772                -accelerator $M1T-T
2773        lappend disable_on_lock \
2774                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2775
2776        .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2777                -command do_add_all \
2778                -accelerator $M1T-I
2779        lappend disable_on_lock \
2780                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2781
2782        .mbar.commit add command -label [mc "Unstage From Commit"] \
2783                -command do_unstage_selection \
2784                -accelerator $M1T-U
2785        lappend disable_on_lock \
2786                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2787
2788        .mbar.commit add command -label [mc "Revert Changes"] \
2789                -command do_revert_selection \
2790                -accelerator $M1T-J
2791        lappend disable_on_lock \
2792                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2793
2794        .mbar.commit add separator
2795
2796        .mbar.commit add command -label [mc "Show Less Context"] \
2797                -command show_less_context \
2798                -accelerator $M1T-\-
2799
2800        .mbar.commit add command -label [mc "Show More Context"] \
2801                -command show_more_context \
2802                -accelerator $M1T-=
2803
2804        .mbar.commit add separator
2805
2806        if {![is_enabled nocommitmsg]} {
2807                .mbar.commit add command -label [mc "Sign Off"] \
2808                        -command do_signoff \
2809                        -accelerator $M1T-S
2810        }
2811
2812        .mbar.commit add command -label [commit_btn_caption] \
2813                -command do_commit \
2814                -accelerator $M1T-Return
2815        lappend disable_on_lock \
2816                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2817}
2818
2819# -- Merge Menu
2820#
2821if {[is_enabled branch]} {
2822        menu .mbar.merge
2823        .mbar.merge add command -label [mc "Local Merge..."] \
2824                -command merge::dialog \
2825                -accelerator $M1T-M
2826        lappend disable_on_lock \
2827                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2828        .mbar.merge add command -label [mc "Abort Merge..."] \
2829                -command merge::reset_hard
2830        lappend disable_on_lock \
2831                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2832}
2833
2834# -- Transport Menu
2835#
2836if {[is_enabled transport]} {
2837        menu .mbar.remote
2838
2839        .mbar.remote add command \
2840                -label [mc "Add..."] \
2841                -command remote_add::dialog \
2842                -accelerator $M1T-A
2843        .mbar.remote add command \
2844                -label [mc "Push..."] \
2845                -command do_push_anywhere \
2846                -accelerator $M1T-P
2847        .mbar.remote add command \
2848                -label [mc "Delete Branch..."] \
2849                -command remote_branch_delete::dialog
2850}
2851
2852if {[is_MacOSX]} {
2853        proc ::tk::mac::ShowPreferences {} {do_options}
2854} else {
2855        # -- Edit Menu
2856        #
2857        .mbar.edit add separator
2858        .mbar.edit add command -label [mc "Options..."] \
2859                -command do_options
2860}
2861
2862# -- Tools Menu
2863#
2864if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2865        set tools_menubar .mbar.tools
2866        menu $tools_menubar
2867        $tools_menubar add separator
2868        $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2869        $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2870        set tools_tailcnt 3
2871        if {[array names repo_config guitool.*.cmd] ne {}} {
2872                tools_populate_all
2873        }
2874}
2875
2876# -- Help Menu
2877#
2878.mbar add cascade -label [mc Help] -menu .mbar.help
2879menu .mbar.help
2880
2881if {[is_MacOSX]} {
2882        .mbar.apple add command -label [mc "About %s" [appname]] \
2883                -command do_about
2884        .mbar.apple add separator
2885} else {
2886        .mbar.help add command -label [mc "About %s" [appname]] \
2887                -command do_about
2888}
2889. configure -menu .mbar
2890
2891set doc_path [githtmldir]
2892if {$doc_path ne {}} {
2893        set doc_path [file join $doc_path index.html]
2894
2895        if {[is_Cygwin]} {
2896                set doc_path [exec cygpath --mixed $doc_path]
2897        }
2898}
2899
2900if {[file isfile $doc_path]} {
2901        set doc_url "file:$doc_path"
2902} else {
2903        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2904}
2905
2906proc start_browser {url} {
2907        git "web--browse" $url
2908}
2909
2910.mbar.help add command -label [mc "Online Documentation"] \
2911        -command [list start_browser $doc_url]
2912
2913.mbar.help add command -label [mc "Show SSH Key"] \
2914        -command do_ssh_key
2915
2916unset doc_path doc_url
2917
2918# -- Standard bindings
2919#
2920wm protocol . WM_DELETE_WINDOW do_quit
2921bind all <$M1B-Key-q> do_quit
2922bind all <$M1B-Key-Q> do_quit
2923bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2924bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2925
2926set subcommand_args {}
2927proc usage {} {
2928        set s "usage: $::argv0 $::subcommand $::subcommand_args"
2929        if {[tk windowingsystem] eq "win32"} {
2930                wm withdraw .
2931                tk_messageBox -icon info -message $s \
2932                        -title [mc "Usage"]
2933        } else {
2934                puts stderr $s
2935        }
2936        exit 1
2937}
2938
2939proc normalize_relpath {path} {
2940        set elements {}
2941        foreach item [file split $path] {
2942                if {$item eq {.}} continue
2943                if {$item eq {..} && [llength $elements] > 0
2944                    && [lindex $elements end] ne {..}} {
2945                        set elements [lrange $elements 0 end-1]
2946                        continue
2947                }
2948                lappend elements $item
2949        }
2950        return [eval file join $elements]
2951}
2952
2953# -- Not a normal commit type invocation?  Do that instead!
2954#
2955switch -- $subcommand {
2956browser -
2957blame {
2958        if {$subcommand eq "blame"} {
2959                set subcommand_args {[--line=<num>] rev? path}
2960        } else {
2961                set subcommand_args {rev? path}
2962        }
2963        if {$argv eq {}} usage
2964        set head {}
2965        set path {}
2966        set jump_spec {}
2967        set is_path 0
2968        foreach a $argv {
2969                if {$is_path || [file exists $_prefix$a]} {
2970                        if {$path ne {}} usage
2971                        set path [normalize_relpath $_prefix$a]
2972                        break
2973                } elseif {$a eq {--}} {
2974                        if {$path ne {}} {
2975                                if {$head ne {}} usage
2976                                set head $path
2977                                set path {}
2978                        }
2979                        set is_path 1
2980                } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2981                        if {$jump_spec ne {} || $head ne {}} usage
2982                        set jump_spec [list $lnum]
2983                } elseif {$head eq {}} {
2984                        if {$head ne {}} usage
2985                        set head $a
2986                        set is_path 1
2987                } else {
2988                        usage
2989                }
2990        }
2991        unset is_path
2992
2993        if {$head ne {} && $path eq {}} {
2994                set path [normalize_relpath $_prefix$head]
2995                set head {}
2996        }
2997
2998        if {$head eq {}} {
2999                load_current_branch
3000        } else {
3001                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3002                        if {[catch {
3003                                        set head [git rev-parse --verify $head]
3004                                } err]} {
3005                                if {[tk windowingsystem] eq "win32"} {
3006                                        tk_messageBox -icon error -title [mc Error] -message $err
3007                                } else {
3008                                        puts stderr $err
3009                                }
3010                                exit 1
3011                        }
3012                }
3013                set current_branch $head
3014        }
3015
3016        wm deiconify .
3017        switch -- $subcommand {
3018        browser {
3019                if {$jump_spec ne {}} usage
3020                if {$head eq {}} {
3021                        if {$path ne {} && [file isdirectory $path]} {
3022                                set head $current_branch
3023                        } else {
3024                                set head $path
3025                                set path {}
3026                        }
3027                }
3028                browser::new $head $path
3029        }
3030        blame   {
3031                if {$head eq {} && ![file exists $path]} {
3032                        catch {wm withdraw .}
3033                        tk_messageBox \
3034                                -icon error \
3035                                -type ok \
3036                                -title [mc "git-gui: fatal error"] \
3037                                -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3038                        exit 1
3039                }
3040                blame::new $head $path $jump_spec
3041        }
3042        }
3043        return
3044}
3045citool -
3046gui {
3047        if {[llength $argv] != 0} {
3048                usage
3049        }
3050        # fall through to setup UI for commits
3051}
3052default {
3053        set err "usage: $argv0 \[{blame|browser|citool}\]"
3054        if {[tk windowingsystem] eq "win32"} {
3055                wm withdraw .
3056                tk_messageBox -icon error -message $err \
3057                        -title [mc "Usage"]
3058        } else {
3059                puts stderr $err
3060        }
3061        exit 1
3062}
3063}
3064
3065# -- Branch Control
3066#
3067${NS}::frame .branch
3068if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3069${NS}::label .branch.l1 \
3070        -text [mc "Current Branch:"] \
3071        -anchor w \
3072        -justify left
3073${NS}::label .branch.cb \
3074        -textvariable current_branch \
3075        -anchor w \
3076        -justify left
3077pack .branch.l1 -side left
3078pack .branch.cb -side left -fill x
3079pack .branch -side top -fill x
3080
3081# -- Main Window Layout
3082#
3083${NS}::panedwindow .vpane -orient horizontal
3084${NS}::panedwindow .vpane.files -orient vertical
3085if {$use_ttk} {
3086        .vpane add .vpane.files
3087} else {
3088        .vpane add .vpane.files -sticky nsew -height 100 -width 200
3089}
3090pack .vpane -anchor n -side top -fill both -expand 1
3091
3092# -- Index File List
3093#
3094${NS}::frame .vpane.files.index -height 100 -width 200
3095tlabel .vpane.files.index.title \
3096        -text [mc "Staged Changes (Will Commit)"] \
3097        -background lightgreen -foreground black
3098text $ui_index -background white -foreground black \
3099        -borderwidth 0 \
3100        -width 20 -height 10 \
3101        -wrap none \
3102        -cursor $cursor_ptr \
3103        -xscrollcommand {.vpane.files.index.sx set} \
3104        -yscrollcommand {.vpane.files.index.sy set} \
3105        -state disabled
3106${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3107${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3108pack .vpane.files.index.title -side top -fill x
3109pack .vpane.files.index.sx -side bottom -fill x
3110pack .vpane.files.index.sy -side right -fill y
3111pack $ui_index -side left -fill both -expand 1
3112
3113# -- Working Directory File List
3114#
3115${NS}::frame .vpane.files.workdir -height 100 -width 200
3116tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3117        -background lightsalmon -foreground black
3118text $ui_workdir -background white -foreground black \
3119        -borderwidth 0 \
3120        -width 20 -height 10 \
3121        -wrap none \
3122        -cursor $cursor_ptr \
3123        -xscrollcommand {.vpane.files.workdir.sx set} \
3124        -yscrollcommand {.vpane.files.workdir.sy set} \
3125        -state disabled
3126${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3127${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3128pack .vpane.files.workdir.title -side top -fill x
3129pack .vpane.files.workdir.sx -side bottom -fill x
3130pack .vpane.files.workdir.sy -side right -fill y
3131pack $ui_workdir -side left -fill both -expand 1
3132
3133.vpane.files add .vpane.files.workdir
3134.vpane.files add .vpane.files.index
3135if {!$use_ttk} {
3136        .vpane.files paneconfigure .vpane.files.workdir -sticky news
3137        .vpane.files paneconfigure .vpane.files.index -sticky news
3138}
3139
3140foreach i [list $ui_index $ui_workdir] {
3141        rmsel_tag $i
3142        $i tag conf in_diff -background [$i tag cget in_sel -background]
3143}
3144unset i
3145
3146# -- Diff and Commit Area
3147#
3148${NS}::frame .vpane.lower -height 300 -width 400
3149${NS}::frame .vpane.lower.commarea
3150${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3151pack .vpane.lower.diff -fill both -expand 1
3152pack .vpane.lower.commarea -side bottom -fill x
3153.vpane add .vpane.lower
3154if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3155
3156# -- Commit Area Buttons
3157#
3158${NS}::frame .vpane.lower.commarea.buttons
3159${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3160        -anchor w \
3161        -justify left
3162pack .vpane.lower.commarea.buttons.l -side top -fill x
3163pack .vpane.lower.commarea.buttons -side left -fill y
3164
3165${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3166        -command ui_do_rescan
3167pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3168lappend disable_on_lock \
3169        {.vpane.lower.commarea.buttons.rescan conf -state}
3170
3171${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3172        -command do_add_all
3173pack .vpane.lower.commarea.buttons.incall -side top -fill x
3174lappend disable_on_lock \
3175        {.vpane.lower.commarea.buttons.incall conf -state}
3176
3177if {![is_enabled nocommitmsg]} {
3178        ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3179                -command do_signoff
3180        pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3181}
3182
3183${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3184        -command do_commit
3185pack .vpane.lower.commarea.buttons.commit -side top -fill x
3186lappend disable_on_lock \
3187        {.vpane.lower.commarea.buttons.commit conf -state}
3188
3189if {![is_enabled nocommit]} {
3190        ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3191                -command do_push_anywhere
3192        pack .vpane.lower.commarea.buttons.push -side top -fill x
3193}
3194
3195# -- Commit Message Buffer
3196#
3197${NS}::frame .vpane.lower.commarea.buffer
3198${NS}::frame .vpane.lower.commarea.buffer.header
3199set ui_comm .vpane.lower.commarea.buffer.t
3200set ui_coml .vpane.lower.commarea.buffer.header.l
3201
3202if {![is_enabled nocommit]} {
3203        ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3204                -text [mc "New Commit"] \
3205                -command do_select_commit_type \
3206                -variable selected_commit_type \
3207                -value new
3208        lappend disable_on_lock \
3209                [list .vpane.lower.commarea.buffer.header.new conf -state]
3210        ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3211                -text [mc "Amend Last Commit"] \
3212                -command do_select_commit_type \
3213                -variable selected_commit_type \
3214                -value amend
3215        lappend disable_on_lock \
3216                [list .vpane.lower.commarea.buffer.header.amend conf -state]
3217}
3218
3219${NS}::label $ui_coml \
3220        -anchor w \
3221        -justify left
3222proc trace_commit_type {varname args} {
3223        global ui_coml commit_type
3224        switch -glob -- $commit_type {
3225        initial       {set txt [mc "Initial Commit Message:"]}
3226        amend         {set txt [mc "Amended Commit Message:"]}
3227        amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3228        amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3229        merge         {set txt [mc "Merge Commit Message:"]}
3230        *             {set txt [mc "Commit Message:"]}
3231        }
3232        $ui_coml conf -text $txt
3233}
3234trace add variable commit_type write trace_commit_type
3235pack $ui_coml -side left -fill x
3236
3237if {![is_enabled nocommit]} {
3238        pack .vpane.lower.commarea.buffer.header.amend -side right
3239        pack .vpane.lower.commarea.buffer.header.new -side right
3240}
3241
3242text $ui_comm -background white -foreground black \
3243        -borderwidth 1 \
3244        -undo true \
3245        -maxundo 20 \
3246        -autoseparators true \
3247        -relief sunken \
3248        -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3249        -font font_diff \
3250        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3251${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3252        -command [list $ui_comm yview]
3253pack .vpane.lower.commarea.buffer.header -side top -fill x
3254pack .vpane.lower.commarea.buffer.sby -side right -fill y
3255pack $ui_comm -side left -fill y
3256pack .vpane.lower.commarea.buffer -side left -fill y
3257
3258# -- Commit Message Buffer Context Menu
3259#
3260set ctxm .vpane.lower.commarea.buffer.ctxm
3261menu $ctxm -tearoff 0
3262$ctxm add command \
3263        -label [mc Cut] \
3264        -command {tk_textCut $ui_comm}
3265$ctxm add command \
3266        -label [mc Copy] \
3267        -command {tk_textCopy $ui_comm}
3268$ctxm add command \
3269        -label [mc Paste] \
3270        -command {tk_textPaste $ui_comm}
3271$ctxm add command \
3272        -label [mc Delete] \
3273        -command {catch {$ui_comm delete sel.first sel.last}}
3274$ctxm add separator
3275$ctxm add command \
3276        -label [mc "Select All"] \
3277        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3278$ctxm add command \
3279        -label [mc "Copy All"] \
3280        -command {
3281                $ui_comm tag add sel 0.0 end
3282                tk_textCopy $ui_comm
3283                $ui_comm tag remove sel 0.0 end
3284        }
3285$ctxm add separator
3286$ctxm add command \
3287        -label [mc "Sign Off"] \
3288        -command do_signoff
3289set ui_comm_ctxm $ctxm
3290
3291# -- Diff Header
3292#
3293proc trace_current_diff_path {varname args} {
3294        global current_diff_path diff_actions file_states
3295        if {$current_diff_path eq {}} {
3296                set s {}
3297                set f {}
3298                set p {}
3299                set o disabled
3300        } else {
3301                set p $current_diff_path
3302                set s [mapdesc [lindex $file_states($p) 0] $p]
3303                set f [mc "File:"]
3304                set p [escape_path $p]
3305                set o normal
3306        }
3307
3308        .vpane.lower.diff.header.status configure -text $s
3309        .vpane.lower.diff.header.file configure -text $f
3310        .vpane.lower.diff.header.path configure -text $p
3311        foreach w $diff_actions {
3312                uplevel #0 $w $o
3313        }
3314}
3315trace add variable current_diff_path write trace_current_diff_path
3316
3317gold_frame .vpane.lower.diff.header
3318tlabel .vpane.lower.diff.header.status \
3319        -background gold \
3320        -foreground black \
3321        -width $max_status_desc \
3322        -anchor w \
3323        -justify left
3324tlabel .vpane.lower.diff.header.file \
3325        -background gold \
3326        -foreground black \
3327        -anchor w \
3328        -justify left
3329tlabel .vpane.lower.diff.header.path \
3330        -background gold \
3331        -foreground black \
3332        -anchor w \
3333        -justify left
3334pack .vpane.lower.diff.header.status -side left
3335pack .vpane.lower.diff.header.file -side left
3336pack .vpane.lower.diff.header.path -fill x
3337set ctxm .vpane.lower.diff.header.ctxm
3338menu $ctxm -tearoff 0
3339$ctxm add command \
3340        -label [mc Copy] \
3341        -command {
3342                clipboard clear
3343                clipboard append \
3344                        -format STRING \
3345                        -type STRING \
3346                        -- $current_diff_path
3347        }
3348lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3349bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3350
3351# -- Diff Body
3352#
3353${NS}::frame .vpane.lower.diff.body
3354set ui_diff .vpane.lower.diff.body.t
3355text $ui_diff -background white -foreground black \
3356        -borderwidth 0 \
3357        -width 80 -height 5 -wrap none \
3358        -font font_diff \
3359        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3360        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3361        -state disabled
3362catch {$ui_diff configure -tabstyle wordprocessor}
3363${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3364        -command [list $ui_diff xview]
3365${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3366        -command [list $ui_diff yview]
3367pack .vpane.lower.diff.body.sbx -side bottom -fill x
3368pack .vpane.lower.diff.body.sby -side right -fill y
3369pack $ui_diff -side left -fill both -expand 1
3370pack .vpane.lower.diff.header -side top -fill x
3371pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3372
3373foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3374        $ui_diff tag configure clr4$n -background $c
3375        $ui_diff tag configure clri4$n -foreground $c
3376        $ui_diff tag configure clr3$n -foreground $c
3377        $ui_diff tag configure clri3$n -background $c
3378}
3379$ui_diff tag configure clr1 -font font_diffbold
3380$ui_diff tag configure clr4 -underline 1
3381
3382$ui_diff tag conf d_info -foreground blue -font font_diffbold
3383
3384$ui_diff tag conf d_cr -elide true
3385$ui_diff tag conf d_@ -font font_diffbold
3386$ui_diff tag conf d_+ -foreground {#00a000}
3387$ui_diff tag conf d_- -foreground red
3388
3389$ui_diff tag conf d_++ -foreground {#00a000}
3390$ui_diff tag conf d_-- -foreground red
3391$ui_diff tag conf d_+s \
3392        -foreground {#00a000} \
3393        -background {#e2effa}
3394$ui_diff tag conf d_-s \
3395        -foreground red \
3396        -background {#e2effa}
3397$ui_diff tag conf d_s+ \
3398        -foreground {#00a000} \
3399        -background ivory1
3400$ui_diff tag conf d_s- \
3401        -foreground red \
3402        -background ivory1
3403
3404$ui_diff tag conf d< \
3405        -foreground orange \
3406        -font font_diffbold
3407$ui_diff tag conf d= \
3408        -foreground orange \
3409        -font font_diffbold
3410$ui_diff tag conf d> \
3411        -foreground orange \
3412        -font font_diffbold
3413
3414$ui_diff tag raise sel
3415
3416# -- Diff Body Context Menu
3417#
3418
3419proc create_common_diff_popup {ctxm} {
3420        $ctxm add command \
3421                -label [mc Refresh] \
3422                -command reshow_diff
3423        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3424        $ctxm add command \
3425                -label [mc Copy] \
3426                -command {tk_textCopy $ui_diff}
3427        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3428        $ctxm add command \
3429                -label [mc "Select All"] \
3430                -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3431        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3432        $ctxm add command \
3433                -label [mc "Copy All"] \
3434                -command {
3435                        $ui_diff tag add sel 0.0 end
3436                        tk_textCopy $ui_diff
3437                        $ui_diff tag remove sel 0.0 end
3438                }
3439        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3440        $ctxm add separator
3441        $ctxm add command \
3442                -label [mc "Decrease Font Size"] \
3443                -command {incr_font_size font_diff -1}
3444        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3445        $ctxm add command \
3446                -label [mc "Increase Font Size"] \
3447                -command {incr_font_size font_diff 1}
3448        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3449        $ctxm add separator
3450        set emenu $ctxm.enc
3451        menu $emenu
3452        build_encoding_menu $emenu [list force_diff_encoding]
3453        $ctxm add cascade \
3454                -label [mc "Encoding"] \
3455                -menu $emenu
3456        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3457        $ctxm add separator
3458        $ctxm add command -label [mc "Options..."] \
3459                -command do_options
3460}
3461
3462set ctxm .vpane.lower.diff.body.ctxm
3463menu $ctxm -tearoff 0
3464$ctxm add command \
3465        -label [mc "Apply/Reverse Hunk"] \
3466        -command {apply_hunk $cursorX $cursorY}
3467set ui_diff_applyhunk [$ctxm index last]
3468lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3469$ctxm add command \
3470        -label [mc "Apply/Reverse Line"] \
3471        -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3472set ui_diff_applyline [$ctxm index last]
3473lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3474$ctxm add separator
3475$ctxm add command \
3476        -label [mc "Show Less Context"] \
3477        -command show_less_context
3478lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3479$ctxm add command \
3480        -label [mc "Show More Context"] \
3481        -command show_more_context
3482lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3483$ctxm add separator
3484create_common_diff_popup $ctxm
3485
3486set ctxmmg .vpane.lower.diff.body.ctxmmg
3487menu $ctxmmg -tearoff 0
3488$ctxmmg add command \
3489        -label [mc "Run Merge Tool"] \
3490        -command {merge_resolve_tool}
3491lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3492$ctxmmg add separator
3493$ctxmmg add command \
3494        -label [mc "Use Remote Version"] \
3495        -command {merge_resolve_one 3}
3496lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3497$ctxmmg add command \
3498        -label [mc "Use Local Version"] \
3499        -command {merge_resolve_one 2}
3500lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3501$ctxmmg add command \
3502        -label [mc "Revert To Base"] \
3503        -command {merge_resolve_one 1}
3504lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3505$ctxmmg add separator
3506$ctxmmg add command \
3507        -label [mc "Show Less Context"] \
3508        -command show_less_context
3509lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3510$ctxmmg add command \
3511        -label [mc "Show More Context"] \
3512        -command show_more_context
3513lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3514$ctxmmg add separator
3515create_common_diff_popup $ctxmmg
3516
3517set ctxmsm .vpane.lower.diff.body.ctxmsm
3518menu $ctxmsm -tearoff 0
3519$ctxmsm add command \
3520        -label [mc "Visualize These Changes In The Submodule"] \
3521        -command {do_gitk -- true}
3522lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3523$ctxmsm add command \
3524        -label [mc "Visualize Current Branch History In The Submodule"] \
3525        -command {do_gitk {} true}
3526lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3527$ctxmsm add command \
3528        -label [mc "Visualize All Branch History In The Submodule"] \
3529        -command {do_gitk --all true}
3530lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3531$ctxmsm add separator
3532$ctxmsm add command \
3533        -label [mc "Start git gui In The Submodule"] \
3534        -command {do_git_gui}
3535lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3536$ctxmsm add separator
3537create_common_diff_popup $ctxmsm
3538
3539proc has_textconv {path} {
3540        if {[is_config_false gui.textconv]} {
3541                return 0
3542        }
3543        set filter [gitattr $path diff set]
3544        set textconv [get_config [join [list diff $filter textconv] .]]
3545        if {$filter ne {set} && $textconv ne {}} {
3546                return 1
3547        } else {
3548                return 0
3549        }
3550}
3551
3552proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3553        global current_diff_path file_states
3554        set ::cursorX $x
3555        set ::cursorY $y
3556        if {[info exists file_states($current_diff_path)]} {
3557                set state [lindex $file_states($current_diff_path) 0]
3558        } else {
3559                set state {__}
3560        }
3561        if {[string first {U} $state] >= 0} {
3562                tk_popup $ctxmmg $X $Y
3563        } elseif {$::is_submodule_diff} {
3564                tk_popup $ctxmsm $X $Y
3565        } else {
3566                set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3567                if {$::ui_index eq $::current_diff_side} {
3568                        set l [mc "Unstage Hunk From Commit"]
3569                        if {$has_range} {
3570                                set t [mc "Unstage Lines From Commit"]
3571                        } else {
3572                                set t [mc "Unstage Line From Commit"]
3573                        }
3574                } else {
3575                        set l [mc "Stage Hunk For Commit"]
3576                        if {$has_range} {
3577                                set t [mc "Stage Lines For Commit"]
3578                        } else {
3579                                set t [mc "Stage Line For Commit"]
3580                        }
3581                }
3582                if {$::is_3way_diff
3583                        || $current_diff_path eq {}
3584                        || {__} eq $state
3585                        || {_O} eq $state
3586                        || [string match {?T} $state]
3587                        || [string match {T?} $state]
3588                        || [has_textconv $current_diff_path]} {
3589                        set s disabled
3590                } else {
3591                        set s normal
3592                }
3593                $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3594                $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3595                tk_popup $ctxm $X $Y
3596        }
3597}
3598bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3599
3600# -- Status Bar
3601#
3602set main_status [::status_bar::new .status]
3603pack .status -anchor w -side bottom -fill x
3604$main_status show [mc "Initializing..."]
3605
3606# -- Load geometry
3607#
3608proc on_ttk_pane_mapped {w pane pos} {
3609        bind $w <Map> {}
3610        after 0 [list after idle [list $w sashpos $pane $pos]]
3611}
3612proc on_tk_pane_mapped {w pane x y} {
3613        bind $w <Map> {}
3614        after 0 [list after idle [list $w sash place $pane $x $y]]
3615}
3616proc on_application_mapped {} {
3617        global repo_config use_ttk
3618        bind . <Map> {}
3619        set gm $repo_config(gui.geometry)
3620        if {$use_ttk} {
3621                bind .vpane <Map> \
3622                    [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3623                bind .vpane.files <Map> \
3624                    [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3625        } else {
3626                bind .vpane <Map> \
3627                    [list on_tk_pane_mapped %W 0 \
3628                         [lindex $gm 1] \
3629                         [lindex [.vpane sash coord 0] 1]]
3630                bind .vpane.files <Map> \
3631                    [list on_tk_pane_mapped %W 0 \
3632                         [lindex [.vpane.files sash coord 0] 0] \
3633                         [lindex $gm 2]]
3634        }
3635        wm geometry . [lindex $gm 0]
3636}
3637if {[info exists repo_config(gui.geometry)]} {
3638        bind . <Map> [list on_application_mapped]
3639        wm geometry . [lindex $repo_config(gui.geometry) 0]
3640}
3641
3642# -- Load window state
3643#
3644if {[info exists repo_config(gui.wmstate)]} {
3645        catch {wm state . $repo_config(gui.wmstate)}
3646}
3647
3648# -- Key Bindings
3649#
3650bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3651bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3652bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3653bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3654bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3655bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3656bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3657bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3658bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3659bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3660bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3661bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3662bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3663bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3664bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3665bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3666bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3667bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3668bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3669bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3670bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3671bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3672
3673bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3674bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3675bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3676bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3677bind $ui_diff <$M1B-Key-v> {break}
3678bind $ui_diff <$M1B-Key-V> {break}
3679bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3680bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3681bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3682bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3683bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3684bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3685bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3686bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3687bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3688bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3689bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3690bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3691bind $ui_diff <Button-1>   {focus %W}
3692
3693if {[is_enabled branch]} {
3694        bind . <$M1B-Key-n> branch_create::dialog
3695        bind . <$M1B-Key-N> branch_create::dialog
3696        bind . <$M1B-Key-o> branch_checkout::dialog
3697        bind . <$M1B-Key-O> branch_checkout::dialog
3698        bind . <$M1B-Key-m> merge::dialog
3699        bind . <$M1B-Key-M> merge::dialog
3700}
3701if {[is_enabled transport]} {
3702        bind . <$M1B-Key-p> do_push_anywhere
3703        bind . <$M1B-Key-P> do_push_anywhere
3704}
3705
3706bind .   <Key-F5>     ui_do_rescan
3707bind .   <$M1B-Key-r> ui_do_rescan
3708bind .   <$M1B-Key-R> ui_do_rescan
3709bind .   <$M1B-Key-s> do_signoff
3710bind .   <$M1B-Key-S> do_signoff
3711bind .   <$M1B-Key-t> do_add_selection
3712bind .   <$M1B-Key-T> do_add_selection
3713bind .   <$M1B-Key-j> do_revert_selection
3714bind .   <$M1B-Key-J> do_revert_selection
3715bind .   <$M1B-Key-i> do_add_all
3716bind .   <$M1B-Key-I> do_add_all
3717bind .   <$M1B-Key-minus> {show_less_context;break}
3718bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3719bind .   <$M1B-Key-equal> {show_more_context;break}
3720bind .   <$M1B-Key-plus> {show_more_context;break}
3721bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3722bind .   <$M1B-Key-Return> do_commit
3723foreach i [list $ui_index $ui_workdir] {
3724        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3725        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3726        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3727}
3728unset i
3729
3730set file_lists($ui_index) [list]
3731set file_lists($ui_workdir) [list]
3732
3733wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3734focus -force $ui_comm
3735
3736# -- Warn the user about environmental problems.  Cygwin's Tcl
3737#    does *not* pass its env array onto any processes it spawns.
3738#    This means that git processes get none of our environment.
3739#
3740if {[is_Cygwin]} {
3741        set ignored_env 0
3742        set suggest_user {}
3743        set msg [mc "Possible environment issues exist.
3744
3745The following environment variables are probably
3746going to be ignored by any Git subprocess run
3747by %s:
3748
3749" [appname]]
3750        foreach name [array names env] {
3751                switch -regexp -- $name {
3752                {^GIT_INDEX_FILE$} -
3753                {^GIT_OBJECT_DIRECTORY$} -
3754                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3755                {^GIT_DIFF_OPTS$} -
3756                {^GIT_EXTERNAL_DIFF$} -
3757                {^GIT_PAGER$} -
3758                {^GIT_TRACE$} -
3759                {^GIT_CONFIG$} -
3760                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3761                        append msg " - $name\n"
3762                        incr ignored_env
3763                }
3764                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3765                        append msg " - $name\n"
3766                        incr ignored_env
3767                        set suggest_user $name
3768                }
3769                }
3770        }
3771        if {$ignored_env > 0} {
3772                append msg [mc "
3773This is due to a known issue with the
3774Tcl binary distributed by Cygwin."]
3775
3776                if {$suggest_user ne {}} {
3777                        append msg [mc "
3778
3779A good replacement for %s
3780is placing values for the user.name and
3781user.email settings into your personal
3782~/.gitconfig file.
3783" $suggest_user]
3784                }
3785                warn_popup $msg
3786        }
3787        unset ignored_env msg suggest_user name
3788}
3789
3790# -- Only initialize complex UI if we are going to stay running.
3791#
3792if {[is_enabled transport]} {
3793        load_all_remotes
3794
3795        set n [.mbar.remote index end]
3796        populate_remotes_menu
3797        set n [expr {[.mbar.remote index end] - $n}]
3798        if {$n > 0} {
3799                if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3800                .mbar.remote insert $n separator
3801        }
3802        unset n
3803}
3804
3805if {[winfo exists $ui_comm]} {
3806        set GITGUI_BCK_exists [load_message GITGUI_BCK]
3807
3808        # -- If both our backup and message files exist use the
3809        #    newer of the two files to initialize the buffer.
3810        #
3811        if {$GITGUI_BCK_exists} {
3812                set m [gitdir GITGUI_MSG]
3813                if {[file isfile $m]} {
3814                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3815                                catch {file delete [gitdir GITGUI_MSG]}
3816                        } else {
3817                                $ui_comm delete 0.0 end
3818                                $ui_comm edit reset
3819                                $ui_comm edit modified false
3820                                catch {file delete [gitdir GITGUI_BCK]}
3821                                set GITGUI_BCK_exists 0
3822                        }
3823                }
3824                unset m
3825        }
3826
3827        proc backup_commit_buffer {} {
3828                global ui_comm GITGUI_BCK_exists
3829
3830                set m [$ui_comm edit modified]
3831                if {$m || $GITGUI_BCK_exists} {
3832                        set msg [string trim [$ui_comm get 0.0 end]]
3833                        regsub -all -line {[ \r\t]+$} $msg {} msg
3834
3835                        if {$msg eq {}} {
3836                                if {$GITGUI_BCK_exists} {
3837                                        catch {file delete [gitdir GITGUI_BCK]}
3838                                        set GITGUI_BCK_exists 0
3839                                }
3840                        } elseif {$m} {
3841                                catch {
3842                                        set fd [open [gitdir GITGUI_BCK] w]
3843                                        puts -nonewline $fd $msg
3844                                        close $fd
3845                                        set GITGUI_BCK_exists 1
3846                                }
3847                        }
3848
3849                        $ui_comm edit modified false
3850                }
3851
3852                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3853        }
3854
3855        backup_commit_buffer
3856
3857        # -- If the user has aspell available we can drive it
3858        #    in pipe mode to spellcheck the commit message.
3859        #
3860        set spell_cmd [list |]
3861        set spell_dict [get_config gui.spellingdictionary]
3862        lappend spell_cmd aspell
3863        if {$spell_dict ne {}} {
3864                lappend spell_cmd --master=$spell_dict
3865        }
3866        lappend spell_cmd --mode=none
3867        lappend spell_cmd --encoding=utf-8
3868        lappend spell_cmd pipe
3869        if {$spell_dict eq {none}
3870         || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3871                bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3872        } else {
3873                set ui_comm_spell [spellcheck::init \
3874                        $spell_fd \
3875                        $ui_comm \
3876                        $ui_comm_ctxm \
3877                ]
3878        }
3879        unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3880}
3881
3882lock_index begin-read
3883if {![winfo ismapped .]} {
3884        wm deiconify .
3885}
3886after 1 {
3887        if {[is_enabled initialamend]} {
3888                force_amend
3889        } else {
3890                do_rescan
3891        }
3892
3893        if {[is_enabled nocommitmsg]} {
3894                $ui_comm configure -state disabled -background gray
3895        }
3896}
3897if {[is_enabled multicommit]} {
3898        after 1000 hint_gc
3899}
3900if {[is_enabled retcode]} {
3901        bind . <Destroy> {+terminate_me %W}
3902}
3903if {$picked && [is_config_true gui.autoexplore]} {
3904        do_explore
3905}
3906
3907# Local variables:
3908# mode: tcl
3909# indent-tabs-mode: t
3910# tab-width: 4
3911# End: