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