git-gui / git-gui.shon commit Merge branch 'jk/no-more-pre-exec-callback' (55ff630)
   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 utf-8]} {
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 {encoding {}}} {
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                if {$encoding ne {}} {
1563                        fconfigure $fd -encoding $encoding
1564                }
1565                set content [string trim [read $fd]]
1566                close $fd
1567                regsub -all -line {[ \r\t]+$} $content {} content
1568                $ui_comm delete 0.0 end
1569                $ui_comm insert end $content
1570                return 1
1571        }
1572        return 0
1573}
1574
1575proc run_prepare_commit_msg_hook {} {
1576        global pch_error
1577
1578        # prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1579        # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1580        # empty file but existent file.
1581
1582        set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1583
1584        if {[file isfile [gitdir MERGE_MSG]]} {
1585                set pcm_source "merge"
1586                set fd_mm [open [gitdir MERGE_MSG] r]
1587                puts -nonewline $fd_pcm [read $fd_mm]
1588                close $fd_mm
1589        } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1590                set pcm_source "squash"
1591                set fd_sm [open [gitdir SQUASH_MSG] r]
1592                puts -nonewline $fd_pcm [read $fd_sm]
1593                close $fd_sm
1594        } else {
1595                set pcm_source ""
1596        }
1597
1598        close $fd_pcm
1599
1600        set fd_ph [githook_read prepare-commit-msg \
1601                        [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1602        if {$fd_ph eq {}} {
1603                catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1604                return 0;
1605        }
1606
1607        ui_status [mc "Calling prepare-commit-msg hook..."]
1608        set pch_error {}
1609
1610        fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1611        fileevent $fd_ph readable \
1612                [list prepare_commit_msg_hook_wait $fd_ph]
1613
1614        return 1;
1615}
1616
1617proc prepare_commit_msg_hook_wait {fd_ph} {
1618        global pch_error
1619
1620        append pch_error [read $fd_ph]
1621        fconfigure $fd_ph -blocking 1
1622        if {[eof $fd_ph]} {
1623                if {[catch {close $fd_ph}]} {
1624                        ui_status [mc "Commit declined by prepare-commit-msg hook."]
1625                        hook_failed_popup prepare-commit-msg $pch_error
1626                        catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1627                        exit 1
1628                } else {
1629                        load_message PREPARE_COMMIT_MSG
1630                }
1631                set pch_error {}
1632                catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1633                return
1634        }
1635        fconfigure $fd_ph -blocking 0
1636        catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1637}
1638
1639proc read_diff_index {fd after} {
1640        global buf_rdi
1641
1642        append buf_rdi [read $fd]
1643        set c 0
1644        set n [string length $buf_rdi]
1645        while {$c < $n} {
1646                set z1 [string first "\0" $buf_rdi $c]
1647                if {$z1 == -1} break
1648                incr z1
1649                set z2 [string first "\0" $buf_rdi $z1]
1650                if {$z2 == -1} break
1651
1652                incr c
1653                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1654                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1655                merge_state \
1656                        [encoding convertfrom $p] \
1657                        [lindex $i 4]? \
1658                        [list [lindex $i 0] [lindex $i 2]] \
1659                        [list]
1660                set c $z2
1661                incr c
1662        }
1663        if {$c < $n} {
1664                set buf_rdi [string range $buf_rdi $c end]
1665        } else {
1666                set buf_rdi {}
1667        }
1668
1669        rescan_done $fd buf_rdi $after
1670}
1671
1672proc read_diff_files {fd after} {
1673        global buf_rdf
1674
1675        append buf_rdf [read $fd]
1676        set c 0
1677        set n [string length $buf_rdf]
1678        while {$c < $n} {
1679                set z1 [string first "\0" $buf_rdf $c]
1680                if {$z1 == -1} break
1681                incr z1
1682                set z2 [string first "\0" $buf_rdf $z1]
1683                if {$z2 == -1} break
1684
1685                incr c
1686                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1687                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1688                merge_state \
1689                        [encoding convertfrom $p] \
1690                        ?[lindex $i 4] \
1691                        [list] \
1692                        [list [lindex $i 0] [lindex $i 2]]
1693                set c $z2
1694                incr c
1695        }
1696        if {$c < $n} {
1697                set buf_rdf [string range $buf_rdf $c end]
1698        } else {
1699                set buf_rdf {}
1700        }
1701
1702        rescan_done $fd buf_rdf $after
1703}
1704
1705proc read_ls_others {fd after} {
1706        global buf_rlo
1707
1708        append buf_rlo [read $fd]
1709        set pck [split $buf_rlo "\0"]
1710        set buf_rlo [lindex $pck end]
1711        foreach p [lrange $pck 0 end-1] {
1712                set p [encoding convertfrom $p]
1713                if {[string index $p end] eq {/}} {
1714                        set p [string range $p 0 end-1]
1715                }
1716                merge_state $p ?O
1717        }
1718        rescan_done $fd buf_rlo $after
1719}
1720
1721proc rescan_done {fd buf after} {
1722        global rescan_active current_diff_path
1723        global file_states repo_config
1724        upvar $buf to_clear
1725
1726        if {![eof $fd]} return
1727        set to_clear {}
1728        close $fd
1729        if {[incr rescan_active -1] > 0} return
1730
1731        prune_selection
1732        unlock_index
1733        display_all_files
1734        if {$current_diff_path ne {}} { reshow_diff $after }
1735        if {$current_diff_path eq {}} { select_first_diff $after }
1736}
1737
1738proc prune_selection {} {
1739        global file_states selected_paths
1740
1741        foreach path [array names selected_paths] {
1742                if {[catch {set still_here $file_states($path)}]} {
1743                        unset selected_paths($path)
1744                }
1745        }
1746}
1747
1748######################################################################
1749##
1750## ui helpers
1751
1752proc mapicon {w state path} {
1753        global all_icons
1754
1755        if {[catch {set r $all_icons($state$w)}]} {
1756                puts "error: no icon for $w state={$state} $path"
1757                return file_plain
1758        }
1759        return $r
1760}
1761
1762proc mapdesc {state path} {
1763        global all_descs
1764
1765        if {[catch {set r $all_descs($state)}]} {
1766                puts "error: no desc for state={$state} $path"
1767                return $state
1768        }
1769        return $r
1770}
1771
1772proc ui_status {msg} {
1773        global main_status
1774        if {[info exists main_status]} {
1775                $main_status show $msg
1776        }
1777}
1778
1779proc ui_ready {{test {}}} {
1780        global main_status
1781        if {[info exists main_status]} {
1782                $main_status show [mc "Ready."] $test
1783        }
1784}
1785
1786proc escape_path {path} {
1787        regsub -all {\\} $path "\\\\" path
1788        regsub -all "\n" $path "\\n" path
1789        return $path
1790}
1791
1792proc short_path {path} {
1793        return [escape_path [lindex [file split $path] end]]
1794}
1795
1796set next_icon_id 0
1797set null_sha1 [string repeat 0 40]
1798
1799proc merge_state {path new_state {head_info {}} {index_info {}}} {
1800        global file_states next_icon_id null_sha1
1801
1802        set s0 [string index $new_state 0]
1803        set s1 [string index $new_state 1]
1804
1805        if {[catch {set info $file_states($path)}]} {
1806                set state __
1807                set icon n[incr next_icon_id]
1808        } else {
1809                set state [lindex $info 0]
1810                set icon [lindex $info 1]
1811                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1812                if {$index_info eq {}} {set index_info [lindex $info 3]}
1813        }
1814
1815        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1816        elseif {$s0 eq {_}} {set s0 _}
1817
1818        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1819        elseif {$s1 eq {_}} {set s1 _}
1820
1821        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1822                set head_info [list 0 $null_sha1]
1823        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1824                && $head_info eq {}} {
1825                set head_info $index_info
1826        } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1827                set index_info $head_info
1828                set head_info {}
1829        }
1830
1831        set file_states($path) [list $s0$s1 $icon \
1832                $head_info $index_info \
1833                ]
1834        return $state
1835}
1836
1837proc display_file_helper {w path icon_name old_m new_m} {
1838        global file_lists
1839
1840        if {$new_m eq {_}} {
1841                set lno [lsearch -sorted -exact $file_lists($w) $path]
1842                if {$lno >= 0} {
1843                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1844                        incr lno
1845                        $w conf -state normal
1846                        $w delete $lno.0 [expr {$lno + 1}].0
1847                        $w conf -state disabled
1848                }
1849        } elseif {$old_m eq {_} && $new_m ne {_}} {
1850                lappend file_lists($w) $path
1851                set file_lists($w) [lsort -unique $file_lists($w)]
1852                set lno [lsearch -sorted -exact $file_lists($w) $path]
1853                incr lno
1854                $w conf -state normal
1855                $w image create $lno.0 \
1856                        -align center -padx 5 -pady 1 \
1857                        -name $icon_name \
1858                        -image [mapicon $w $new_m $path]
1859                $w insert $lno.1 "[escape_path $path]\n"
1860                $w conf -state disabled
1861        } elseif {$old_m ne $new_m} {
1862                $w conf -state normal
1863                $w image conf $icon_name -image [mapicon $w $new_m $path]
1864                $w conf -state disabled
1865        }
1866}
1867
1868proc display_file {path state} {
1869        global file_states selected_paths
1870        global ui_index ui_workdir
1871
1872        set old_m [merge_state $path $state]
1873        set s $file_states($path)
1874        set new_m [lindex $s 0]
1875        set icon_name [lindex $s 1]
1876
1877        set o [string index $old_m 0]
1878        set n [string index $new_m 0]
1879        if {$o eq {U}} {
1880                set o _
1881        }
1882        if {$n eq {U}} {
1883                set n _
1884        }
1885        display_file_helper     $ui_index $path $icon_name $o $n
1886
1887        if {[string index $old_m 0] eq {U}} {
1888                set o U
1889        } else {
1890                set o [string index $old_m 1]
1891        }
1892        if {[string index $new_m 0] eq {U}} {
1893                set n U
1894        } else {
1895                set n [string index $new_m 1]
1896        }
1897        display_file_helper     $ui_workdir $path $icon_name $o $n
1898
1899        if {$new_m eq {__}} {
1900                unset file_states($path)
1901                catch {unset selected_paths($path)}
1902        }
1903}
1904
1905proc display_all_files_helper {w path icon_name m} {
1906        global file_lists
1907
1908        lappend file_lists($w) $path
1909        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1910        $w image create end \
1911                -align center -padx 5 -pady 1 \
1912                -name $icon_name \
1913                -image [mapicon $w $m $path]
1914        $w insert end "[escape_path $path]\n"
1915}
1916
1917set files_warning 0
1918proc display_all_files {} {
1919        global ui_index ui_workdir
1920        global file_states file_lists
1921        global last_clicked
1922        global files_warning
1923
1924        $ui_index conf -state normal
1925        $ui_workdir conf -state normal
1926
1927        $ui_index delete 0.0 end
1928        $ui_workdir delete 0.0 end
1929        set last_clicked {}
1930
1931        set file_lists($ui_index) [list]
1932        set file_lists($ui_workdir) [list]
1933
1934        set to_display [lsort [array names file_states]]
1935        set display_limit [get_config gui.maxfilesdisplayed]
1936        if {[llength $to_display] > $display_limit} {
1937                if {!$files_warning} {
1938                        # do not repeatedly warn:
1939                        set files_warning 1
1940                        info_popup [mc "Displaying only %s of %s files." \
1941                                $display_limit [llength $to_display]]
1942                }
1943                set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1944        }
1945        foreach path $to_display {
1946                set s $file_states($path)
1947                set m [lindex $s 0]
1948                set icon_name [lindex $s 1]
1949
1950                set s [string index $m 0]
1951                if {$s ne {U} && $s ne {_}} {
1952                        display_all_files_helper $ui_index $path \
1953                                $icon_name $s
1954                }
1955
1956                if {[string index $m 0] eq {U}} {
1957                        set s U
1958                } else {
1959                        set s [string index $m 1]
1960                }
1961                if {$s ne {_}} {
1962                        display_all_files_helper $ui_workdir $path \
1963                                $icon_name $s
1964                }
1965        }
1966
1967        $ui_index conf -state disabled
1968        $ui_workdir conf -state disabled
1969}
1970
1971######################################################################
1972##
1973## icons
1974
1975set filemask {
1976#define mask_width 14
1977#define mask_height 15
1978static unsigned char mask_bits[] = {
1979   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1980   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1981   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1982}
1983
1984image create bitmap file_plain -background white -foreground black -data {
1985#define plain_width 14
1986#define plain_height 15
1987static unsigned char plain_bits[] = {
1988   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1989   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1990   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1991} -maskdata $filemask
1992
1993image create bitmap file_mod -background white -foreground blue -data {
1994#define mod_width 14
1995#define mod_height 15
1996static unsigned char mod_bits[] = {
1997   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1998   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1999   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2000} -maskdata $filemask
2001
2002image create bitmap file_fulltick -background white -foreground "#007000" -data {
2003#define file_fulltick_width 14
2004#define file_fulltick_height 15
2005static unsigned char file_fulltick_bits[] = {
2006   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2007   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2008   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2009} -maskdata $filemask
2010
2011image create bitmap file_question -background white -foreground black -data {
2012#define file_question_width 14
2013#define file_question_height 15
2014static unsigned char file_question_bits[] = {
2015   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2016   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2017   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2018} -maskdata $filemask
2019
2020image create bitmap file_removed -background white -foreground red -data {
2021#define file_removed_width 14
2022#define file_removed_height 15
2023static unsigned char file_removed_bits[] = {
2024   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2025   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2026   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2027} -maskdata $filemask
2028
2029image create bitmap file_merge -background white -foreground blue -data {
2030#define file_merge_width 14
2031#define file_merge_height 15
2032static unsigned char file_merge_bits[] = {
2033   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2034   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2035   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2036} -maskdata $filemask
2037
2038image create bitmap file_statechange -background white -foreground green -data {
2039#define file_statechange_width 14
2040#define file_statechange_height 15
2041static unsigned char file_statechange_bits[] = {
2042   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
2043   0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
2044   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2045} -maskdata $filemask
2046
2047set ui_index .vpane.files.index.list
2048set ui_workdir .vpane.files.workdir.list
2049
2050set all_icons(_$ui_index)   file_plain
2051set all_icons(A$ui_index)   file_plain
2052set all_icons(M$ui_index)   file_fulltick
2053set all_icons(D$ui_index)   file_removed
2054set all_icons(U$ui_index)   file_merge
2055set all_icons(T$ui_index)   file_statechange
2056
2057set all_icons(_$ui_workdir) file_plain
2058set all_icons(M$ui_workdir) file_mod
2059set all_icons(D$ui_workdir) file_question
2060set all_icons(U$ui_workdir) file_merge
2061set all_icons(O$ui_workdir) file_plain
2062set all_icons(T$ui_workdir) file_statechange
2063
2064set max_status_desc 0
2065foreach i {
2066                {__ {mc "Unmodified"}}
2067
2068                {_M {mc "Modified, not staged"}}
2069                {M_ {mc "Staged for commit"}}
2070                {MM {mc "Portions staged for commit"}}
2071                {MD {mc "Staged for commit, missing"}}
2072
2073                {_T {mc "File type changed, not staged"}}
2074                {MT {mc "File type changed, old type staged for commit"}}
2075                {AT {mc "File type changed, old type staged for commit"}}
2076                {T_ {mc "File type changed, staged"}}
2077                {TM {mc "File type change staged, modification not staged"}}
2078                {TD {mc "File type change staged, file missing"}}
2079
2080                {_O {mc "Untracked, not staged"}}
2081                {A_ {mc "Staged for commit"}}
2082                {AM {mc "Portions staged for commit"}}
2083                {AD {mc "Staged for commit, missing"}}
2084
2085                {_D {mc "Missing"}}
2086                {D_ {mc "Staged for removal"}}
2087                {DO {mc "Staged for removal, still present"}}
2088
2089                {_U {mc "Requires merge resolution"}}
2090                {U_ {mc "Requires merge resolution"}}
2091                {UU {mc "Requires merge resolution"}}
2092                {UM {mc "Requires merge resolution"}}
2093                {UD {mc "Requires merge resolution"}}
2094                {UT {mc "Requires merge resolution"}}
2095        } {
2096        set text [eval [lindex $i 1]]
2097        if {$max_status_desc < [string length $text]} {
2098                set max_status_desc [string length $text]
2099        }
2100        set all_descs([lindex $i 0]) $text
2101}
2102unset i
2103
2104######################################################################
2105##
2106## util
2107
2108proc scrollbar2many {list mode args} {
2109        foreach w $list {eval $w $mode $args}
2110}
2111
2112proc many2scrollbar {list mode sb top bottom} {
2113        $sb set $top $bottom
2114        foreach w $list {$w $mode moveto $top}
2115}
2116
2117proc incr_font_size {font {amt 1}} {
2118        set sz [font configure $font -size]
2119        incr sz $amt
2120        font configure $font -size $sz
2121        font configure ${font}bold -size $sz
2122        font configure ${font}italic -size $sz
2123}
2124
2125######################################################################
2126##
2127## ui commands
2128
2129set starting_gitk_msg [mc "Starting gitk... please wait..."]
2130
2131proc do_gitk {revs {is_submodule false}} {
2132        global current_diff_path file_states current_diff_side ui_index
2133        global _gitdir _gitworktree
2134
2135        # -- Always start gitk through whatever we were loaded with.  This
2136        #    lets us bypass using shell process on Windows systems.
2137        #
2138        set exe [_which gitk -script]
2139        set cmd [list [info nameofexecutable] $exe]
2140        if {$exe eq {}} {
2141                error_popup [mc "Couldn't find gitk in PATH"]
2142        } else {
2143                global env
2144
2145                set pwd [pwd]
2146
2147                if {!$is_submodule} {
2148                        if {![is_bare]} {
2149                                cd $_gitworktree
2150                        }
2151                } else {
2152                        cd $current_diff_path
2153                        if {$revs eq {--}} {
2154                                set s $file_states($current_diff_path)
2155                                set old_sha1 {}
2156                                set new_sha1 {}
2157                                switch -glob -- [lindex $s 0] {
2158                                M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2159                                _M { set old_sha1 [lindex [lindex $s 3] 1] }
2160                                MM {
2161                                        if {$current_diff_side eq $ui_index} {
2162                                                set old_sha1 [lindex [lindex $s 2] 1]
2163                                                set new_sha1 [lindex [lindex $s 3] 1]
2164                                        } else {
2165                                                set old_sha1 [lindex [lindex $s 3] 1]
2166                                        }
2167                                }
2168                                }
2169                                set revs $old_sha1...$new_sha1
2170                        }
2171                        # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2172                        # we've been using for the main repository, so unset them.
2173                        # TODO we could make life easier (start up faster?) for gitk
2174                        # by setting these to the appropriate values to allow gitk
2175                        # to skip the heuristics to find their proper value
2176                        unset env(GIT_DIR)
2177                        unset env(GIT_WORK_TREE)
2178                }
2179                eval exec $cmd $revs "--" "--" &
2180
2181                set env(GIT_DIR) $_gitdir
2182                set env(GIT_WORK_TREE) $_gitworktree
2183                cd $pwd
2184
2185                ui_status $::starting_gitk_msg
2186                after 10000 {
2187                        ui_ready $starting_gitk_msg
2188                }
2189        }
2190}
2191
2192proc do_git_gui {} {
2193        global current_diff_path
2194
2195        # -- Always start git gui through whatever we were loaded with.  This
2196        #    lets us bypass using shell process on Windows systems.
2197        #
2198        set exe [list [_which git]]
2199        if {$exe eq {}} {
2200                error_popup [mc "Couldn't find git gui in PATH"]
2201        } else {
2202                global env
2203                global _gitdir _gitworktree
2204
2205                # see note in do_gitk about unsetting these vars when
2206                # running tools in a submodule
2207                unset env(GIT_DIR)
2208                unset env(GIT_WORK_TREE)
2209
2210                set pwd [pwd]
2211                cd $current_diff_path
2212
2213                eval exec $exe gui &
2214
2215                set env(GIT_DIR) $_gitdir
2216                set env(GIT_WORK_TREE) $_gitworktree
2217                cd $pwd
2218
2219                ui_status $::starting_gitk_msg
2220                after 10000 {
2221                        ui_ready $starting_gitk_msg
2222                }
2223        }
2224}
2225
2226proc do_explore {} {
2227        global _gitworktree
2228        set explorer {}
2229        if {[is_Cygwin] || [is_Windows]} {
2230                set explorer "explorer.exe"
2231        } elseif {[is_MacOSX]} {
2232                set explorer "open"
2233        } else {
2234                # freedesktop.org-conforming system is our best shot
2235                set explorer "xdg-open"
2236        }
2237        eval exec $explorer [list [file nativename $_gitworktree]] &
2238}
2239
2240set is_quitting 0
2241set ret_code    1
2242
2243proc terminate_me {win} {
2244        global ret_code
2245        if {$win ne {.}} return
2246        exit $ret_code
2247}
2248
2249proc do_quit {{rc {1}}} {
2250        global ui_comm is_quitting repo_config commit_type
2251        global GITGUI_BCK_exists GITGUI_BCK_i
2252        global ui_comm_spell
2253        global ret_code use_ttk
2254
2255        if {$is_quitting} return
2256        set is_quitting 1
2257
2258        if {[winfo exists $ui_comm]} {
2259                # -- Stash our current commit buffer.
2260                #
2261                set save [gitdir GITGUI_MSG]
2262                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2263                        file rename -force [gitdir GITGUI_BCK] $save
2264                        set GITGUI_BCK_exists 0
2265                } else {
2266                        set msg [string trim [$ui_comm get 0.0 end]]
2267                        regsub -all -line {[ \r\t]+$} $msg {} msg
2268                        if {(![string match amend* $commit_type]
2269                                || [$ui_comm edit modified])
2270                                && $msg ne {}} {
2271                                catch {
2272                                        set fd [open $save w]
2273                                        fconfigure $fd -encoding utf-8
2274                                        puts -nonewline $fd $msg
2275                                        close $fd
2276                                }
2277                        } else {
2278                                catch {file delete $save}
2279                        }
2280                }
2281
2282                # -- Cancel our spellchecker if its running.
2283                #
2284                if {[info exists ui_comm_spell]} {
2285                        $ui_comm_spell stop
2286                }
2287
2288                # -- Remove our editor backup, its not needed.
2289                #
2290                after cancel $GITGUI_BCK_i
2291                if {$GITGUI_BCK_exists} {
2292                        catch {file delete [gitdir GITGUI_BCK]}
2293                }
2294
2295                # -- Stash our current window geometry into this repository.
2296                #
2297                set cfg_wmstate [wm state .]
2298                if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2299                        set rc_wmstate {}
2300                }
2301                if {$cfg_wmstate ne $rc_wmstate} {
2302                        catch {git config gui.wmstate $cfg_wmstate}
2303                }
2304                if {$cfg_wmstate eq {zoomed}} {
2305                        # on Windows wm geometry will lie about window
2306                        # position (but not size) when window is zoomed
2307                        # restore the window before querying wm geometry
2308                        wm state . normal
2309                }
2310                set cfg_geometry [list]
2311                lappend cfg_geometry [wm geometry .]
2312                if {$use_ttk} {
2313                        lappend cfg_geometry [.vpane sashpos 0]
2314                        lappend cfg_geometry [.vpane.files sashpos 0]
2315                } else {
2316                        lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2317                        lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2318                }
2319                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2320                        set rc_geometry {}
2321                }
2322                if {$cfg_geometry ne $rc_geometry} {
2323                        catch {git config gui.geometry $cfg_geometry}
2324                }
2325        }
2326
2327        set ret_code $rc
2328
2329        # Briefly enable send again, working around Tk bug
2330        # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2331        tk appname [appname]
2332
2333        destroy .
2334}
2335
2336proc do_rescan {} {
2337        rescan ui_ready
2338}
2339
2340proc ui_do_rescan {} {
2341        rescan {force_first_diff ui_ready}
2342}
2343
2344proc do_commit {} {
2345        commit_tree
2346}
2347
2348proc next_diff {{after {}}} {
2349        global next_diff_p next_diff_w next_diff_i
2350        show_diff $next_diff_p $next_diff_w {} {} $after
2351}
2352
2353proc find_anchor_pos {lst name} {
2354        set lid [lsearch -sorted -exact $lst $name]
2355
2356        if {$lid == -1} {
2357                set lid 0
2358                foreach lname $lst {
2359                        if {$lname >= $name} break
2360                        incr lid
2361                }
2362        }
2363
2364        return $lid
2365}
2366
2367proc find_file_from {flist idx delta path mmask} {
2368        global file_states
2369
2370        set len [llength $flist]
2371        while {$idx >= 0 && $idx < $len} {
2372                set name [lindex $flist $idx]
2373
2374                if {$name ne $path && [info exists file_states($name)]} {
2375                        set state [lindex $file_states($name) 0]
2376
2377                        if {$mmask eq {} || [regexp $mmask $state]} {
2378                                return $idx
2379                        }
2380                }
2381
2382                incr idx $delta
2383        }
2384
2385        return {}
2386}
2387
2388proc find_next_diff {w path {lno {}} {mmask {}}} {
2389        global next_diff_p next_diff_w next_diff_i
2390        global file_lists ui_index ui_workdir
2391
2392        set flist $file_lists($w)
2393        if {$lno eq {}} {
2394                set lno [find_anchor_pos $flist $path]
2395        } else {
2396                incr lno -1
2397        }
2398
2399        if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2400                if {$w eq $ui_index} {
2401                        set mmask "^$mmask"
2402                } else {
2403                        set mmask "$mmask\$"
2404                }
2405        }
2406
2407        set idx [find_file_from $flist $lno 1 $path $mmask]
2408        if {$idx eq {}} {
2409                incr lno -1
2410                set idx [find_file_from $flist $lno -1 $path $mmask]
2411        }
2412
2413        if {$idx ne {}} {
2414                set next_diff_w $w
2415                set next_diff_p [lindex $flist $idx]
2416                set next_diff_i [expr {$idx+1}]
2417                return 1
2418        } else {
2419                return 0
2420        }
2421}
2422
2423proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2424        global current_diff_path
2425
2426        if {$path ne $current_diff_path} {
2427                return {}
2428        } elseif {[find_next_diff $w $path $lno $mmask]} {
2429                return {next_diff;}
2430        } else {
2431                return {reshow_diff;}
2432        }
2433}
2434
2435proc select_first_diff {after} {
2436        global ui_workdir
2437
2438        if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2439            [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2440                next_diff $after
2441        } else {
2442                uplevel #0 $after
2443        }
2444}
2445
2446proc force_first_diff {after} {
2447        global ui_workdir current_diff_path file_states
2448
2449        if {[info exists file_states($current_diff_path)]} {
2450                set state [lindex $file_states($current_diff_path) 0]
2451        } else {
2452                set state {OO}
2453        }
2454
2455        set reselect 0
2456        if {[string first {U} $state] >= 0} {
2457                # Already a conflict, do nothing
2458        } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2459                set reselect 1
2460        } elseif {[string index $state 1] ne {O}} {
2461                # Already a diff & no conflicts, do nothing
2462        } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2463                set reselect 1
2464        }
2465
2466        if {$reselect} {
2467                next_diff $after
2468        } else {
2469                uplevel #0 $after
2470        }
2471}
2472
2473proc toggle_or_diff {w x y} {
2474        global file_states file_lists current_diff_path ui_index ui_workdir
2475        global last_clicked selected_paths
2476
2477        set pos [split [$w index @$x,$y] .]
2478        set lno [lindex $pos 0]
2479        set col [lindex $pos 1]
2480        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2481        if {$path eq {}} {
2482                set last_clicked {}
2483                return
2484        }
2485
2486        set last_clicked [list $w $lno]
2487        array unset selected_paths
2488        $ui_index tag remove in_sel 0.0 end
2489        $ui_workdir tag remove in_sel 0.0 end
2490
2491        # Determine the state of the file
2492        if {[info exists file_states($path)]} {
2493                set state [lindex $file_states($path) 0]
2494        } else {
2495                set state {__}
2496        }
2497
2498        # Restage the file, or simply show the diff
2499        if {$col == 0 && $y > 1} {
2500                # Conflicts need special handling
2501                if {[string first {U} $state] >= 0} {
2502                        # $w must always be $ui_workdir, but...
2503                        if {$w ne $ui_workdir} { set lno {} }
2504                        merge_stage_workdir $path $lno
2505                        return
2506                }
2507
2508                if {[string index $state 1] eq {O}} {
2509                        set mmask {}
2510                } else {
2511                        set mmask {[^O]}
2512                }
2513
2514                set after [next_diff_after_action $w $path $lno $mmask]
2515
2516                if {$w eq $ui_index} {
2517                        update_indexinfo \
2518                                "Unstaging [short_path $path] from commit" \
2519                                [list $path] \
2520                                [concat $after [list ui_ready]]
2521                } elseif {$w eq $ui_workdir} {
2522                        update_index \
2523                                "Adding [short_path $path]" \
2524                                [list $path] \
2525                                [concat $after [list ui_ready]]
2526                }
2527        } else {
2528                set selected_paths($path) 1
2529                show_diff $path $w $lno
2530        }
2531}
2532
2533proc add_one_to_selection {w x y} {
2534        global file_lists last_clicked selected_paths
2535
2536        set lno [lindex [split [$w index @$x,$y] .] 0]
2537        set path [lindex $file_lists($w) [expr {$lno - 1}]]
2538        if {$path eq {}} {
2539                set last_clicked {}
2540                return
2541        }
2542
2543        if {$last_clicked ne {}
2544                && [lindex $last_clicked 0] ne $w} {
2545                array unset selected_paths
2546                [lindex $last_clicked 0] tag remove in_sel 0.0 end
2547        }
2548
2549        set last_clicked [list $w $lno]
2550        if {[catch {set in_sel $selected_paths($path)}]} {
2551                set in_sel 0
2552        }
2553        if {$in_sel} {
2554                unset selected_paths($path)
2555                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2556        } else {
2557                set selected_paths($path) 1
2558                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2559        }
2560}
2561
2562proc add_range_to_selection {w x y} {
2563        global file_lists last_clicked selected_paths
2564
2565        if {[lindex $last_clicked 0] ne $w} {
2566                toggle_or_diff $w $x $y
2567                return
2568        }
2569
2570        set lno [lindex [split [$w index @$x,$y] .] 0]
2571        set lc [lindex $last_clicked 1]
2572        if {$lc < $lno} {
2573                set begin $lc
2574                set end $lno
2575        } else {
2576                set begin $lno
2577                set end $lc
2578        }
2579
2580        foreach path [lrange $file_lists($w) \
2581                [expr {$begin - 1}] \
2582                [expr {$end - 1}]] {
2583                set selected_paths($path) 1
2584        }
2585        $w tag add in_sel $begin.0 [expr {$end + 1}].0
2586}
2587
2588proc show_more_context {} {
2589        global repo_config
2590        if {$repo_config(gui.diffcontext) < 99} {
2591                incr repo_config(gui.diffcontext)
2592                reshow_diff
2593        }
2594}
2595
2596proc show_less_context {} {
2597        global repo_config
2598        if {$repo_config(gui.diffcontext) > 1} {
2599                incr repo_config(gui.diffcontext) -1
2600                reshow_diff
2601        }
2602}
2603
2604######################################################################
2605##
2606## ui construction
2607
2608set ui_comm {}
2609
2610# -- Menu Bar
2611#
2612menu .mbar -tearoff 0
2613if {[is_MacOSX]} {
2614        # -- Apple Menu (Mac OS X only)
2615        #
2616        .mbar add cascade -label Apple -menu .mbar.apple
2617        menu .mbar.apple
2618}
2619.mbar add cascade -label [mc Repository] -menu .mbar.repository
2620.mbar add cascade -label [mc Edit] -menu .mbar.edit
2621if {[is_enabled branch]} {
2622        .mbar add cascade -label [mc Branch] -menu .mbar.branch
2623}
2624if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2625        .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2626}
2627if {[is_enabled transport]} {
2628        .mbar add cascade -label [mc Merge] -menu .mbar.merge
2629        .mbar add cascade -label [mc Remote] -menu .mbar.remote
2630}
2631if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2632        .mbar add cascade -label [mc Tools] -menu .mbar.tools
2633}
2634
2635# -- Repository Menu
2636#
2637menu .mbar.repository
2638
2639if {![is_bare]} {
2640        .mbar.repository add command \
2641                -label [mc "Explore Working Copy"] \
2642                -command {do_explore}
2643        .mbar.repository add separator
2644}
2645
2646.mbar.repository add command \
2647        -label [mc "Browse Current Branch's Files"] \
2648        -command {browser::new $current_branch}
2649set ui_browse_current [.mbar.repository index last]
2650.mbar.repository add command \
2651        -label [mc "Browse Branch Files..."] \
2652        -command browser_open::dialog
2653.mbar.repository add separator
2654
2655.mbar.repository add command \
2656        -label [mc "Visualize Current Branch's History"] \
2657        -command {do_gitk $current_branch}
2658set ui_visualize_current [.mbar.repository index last]
2659.mbar.repository add command \
2660        -label [mc "Visualize All Branch History"] \
2661        -command {do_gitk --all}
2662.mbar.repository add separator
2663
2664proc current_branch_write {args} {
2665        global current_branch
2666        .mbar.repository entryconf $::ui_browse_current \
2667                -label [mc "Browse %s's Files" $current_branch]
2668        .mbar.repository entryconf $::ui_visualize_current \
2669                -label [mc "Visualize %s's History" $current_branch]
2670}
2671trace add variable current_branch write current_branch_write
2672
2673if {[is_enabled multicommit]} {
2674        .mbar.repository add command -label [mc "Database Statistics"] \
2675                -command do_stats
2676
2677        .mbar.repository add command -label [mc "Compress Database"] \
2678                -command do_gc
2679
2680        .mbar.repository add command -label [mc "Verify Database"] \
2681                -command do_fsck_objects
2682
2683        .mbar.repository add separator
2684
2685        if {[is_Cygwin]} {
2686                .mbar.repository add command \
2687                        -label [mc "Create Desktop Icon"] \
2688                        -command do_cygwin_shortcut
2689        } elseif {[is_Windows]} {
2690                .mbar.repository add command \
2691                        -label [mc "Create Desktop Icon"] \
2692                        -command do_windows_shortcut
2693        } elseif {[is_MacOSX]} {
2694                .mbar.repository add command \
2695                        -label [mc "Create Desktop Icon"] \
2696                        -command do_macosx_app
2697        }
2698}
2699
2700if {[is_MacOSX]} {
2701        proc ::tk::mac::Quit {args} { do_quit }
2702} else {
2703        .mbar.repository add command -label [mc Quit] \
2704                -command do_quit \
2705                -accelerator $M1T-Q
2706}
2707
2708# -- Edit Menu
2709#
2710menu .mbar.edit
2711.mbar.edit add command -label [mc Undo] \
2712        -command {catch {[focus] edit undo}} \
2713        -accelerator $M1T-Z
2714.mbar.edit add command -label [mc Redo] \
2715        -command {catch {[focus] edit redo}} \
2716        -accelerator $M1T-Y
2717.mbar.edit add separator
2718.mbar.edit add command -label [mc Cut] \
2719        -command {catch {tk_textCut [focus]}} \
2720        -accelerator $M1T-X
2721.mbar.edit add command -label [mc Copy] \
2722        -command {catch {tk_textCopy [focus]}} \
2723        -accelerator $M1T-C
2724.mbar.edit add command -label [mc Paste] \
2725        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2726        -accelerator $M1T-V
2727.mbar.edit add command -label [mc Delete] \
2728        -command {catch {[focus] delete sel.first sel.last}} \
2729        -accelerator Del
2730.mbar.edit add separator
2731.mbar.edit add command -label [mc "Select All"] \
2732        -command {catch {[focus] tag add sel 0.0 end}} \
2733        -accelerator $M1T-A
2734
2735# -- Branch Menu
2736#
2737if {[is_enabled branch]} {
2738        menu .mbar.branch
2739
2740        .mbar.branch add command -label [mc "Create..."] \
2741                -command branch_create::dialog \
2742                -accelerator $M1T-N
2743        lappend disable_on_lock [list .mbar.branch entryconf \
2744                [.mbar.branch index last] -state]
2745
2746        .mbar.branch add command -label [mc "Checkout..."] \
2747                -command branch_checkout::dialog \
2748                -accelerator $M1T-O
2749        lappend disable_on_lock [list .mbar.branch entryconf \
2750                [.mbar.branch index last] -state]
2751
2752        .mbar.branch add command -label [mc "Rename..."] \
2753                -command branch_rename::dialog
2754        lappend disable_on_lock [list .mbar.branch entryconf \
2755                [.mbar.branch index last] -state]
2756
2757        .mbar.branch add command -label [mc "Delete..."] \
2758                -command branch_delete::dialog
2759        lappend disable_on_lock [list .mbar.branch entryconf \
2760                [.mbar.branch index last] -state]
2761
2762        .mbar.branch add command -label [mc "Reset..."] \
2763                -command merge::reset_hard
2764        lappend disable_on_lock [list .mbar.branch entryconf \
2765                [.mbar.branch index last] -state]
2766}
2767
2768# -- Commit Menu
2769#
2770proc commit_btn_caption {} {
2771        if {[is_enabled nocommit]} {
2772                return [mc "Done"]
2773        } else {
2774                return [mc Commit@@verb]
2775        }
2776}
2777
2778if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2779        menu .mbar.commit
2780
2781        if {![is_enabled nocommit]} {
2782                .mbar.commit add radiobutton \
2783                        -label [mc "New Commit"] \
2784                        -command do_select_commit_type \
2785                        -variable selected_commit_type \
2786                        -value new
2787                lappend disable_on_lock \
2788                        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2789
2790                .mbar.commit add radiobutton \
2791                        -label [mc "Amend Last Commit"] \
2792                        -command do_select_commit_type \
2793                        -variable selected_commit_type \
2794                        -value amend
2795                lappend disable_on_lock \
2796                        [list .mbar.commit entryconf [.mbar.commit index last] -state]
2797
2798                .mbar.commit add separator
2799        }
2800
2801        .mbar.commit add command -label [mc Rescan] \
2802                -command ui_do_rescan \
2803                -accelerator F5
2804        lappend disable_on_lock \
2805                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2806
2807        .mbar.commit add command -label [mc "Stage To Commit"] \
2808                -command do_add_selection \
2809                -accelerator $M1T-T
2810        lappend disable_on_lock \
2811                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2812
2813        .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2814                -command do_add_all \
2815                -accelerator $M1T-I
2816        lappend disable_on_lock \
2817                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2818
2819        .mbar.commit add command -label [mc "Unstage From Commit"] \
2820                -command do_unstage_selection \
2821                -accelerator $M1T-U
2822        lappend disable_on_lock \
2823                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2824
2825        .mbar.commit add command -label [mc "Revert Changes"] \
2826                -command do_revert_selection \
2827                -accelerator $M1T-J
2828        lappend disable_on_lock \
2829                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2830
2831        .mbar.commit add separator
2832
2833        .mbar.commit add command -label [mc "Show Less Context"] \
2834                -command show_less_context \
2835                -accelerator $M1T-\-
2836
2837        .mbar.commit add command -label [mc "Show More Context"] \
2838                -command show_more_context \
2839                -accelerator $M1T-=
2840
2841        .mbar.commit add separator
2842
2843        if {![is_enabled nocommitmsg]} {
2844                .mbar.commit add command -label [mc "Sign Off"] \
2845                        -command do_signoff \
2846                        -accelerator $M1T-S
2847        }
2848
2849        .mbar.commit add command -label [commit_btn_caption] \
2850                -command do_commit \
2851                -accelerator $M1T-Return
2852        lappend disable_on_lock \
2853                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2854}
2855
2856# -- Merge Menu
2857#
2858if {[is_enabled branch]} {
2859        menu .mbar.merge
2860        .mbar.merge add command -label [mc "Local Merge..."] \
2861                -command merge::dialog \
2862                -accelerator $M1T-M
2863        lappend disable_on_lock \
2864                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2865        .mbar.merge add command -label [mc "Abort Merge..."] \
2866                -command merge::reset_hard
2867        lappend disable_on_lock \
2868                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2869}
2870
2871# -- Transport Menu
2872#
2873if {[is_enabled transport]} {
2874        menu .mbar.remote
2875
2876        .mbar.remote add command \
2877                -label [mc "Add..."] \
2878                -command remote_add::dialog \
2879                -accelerator $M1T-A
2880        .mbar.remote add command \
2881                -label [mc "Push..."] \
2882                -command do_push_anywhere \
2883                -accelerator $M1T-P
2884        .mbar.remote add command \
2885                -label [mc "Delete Branch..."] \
2886                -command remote_branch_delete::dialog
2887}
2888
2889if {[is_MacOSX]} {
2890        proc ::tk::mac::ShowPreferences {} {do_options}
2891} else {
2892        # -- Edit Menu
2893        #
2894        .mbar.edit add separator
2895        .mbar.edit add command -label [mc "Options..."] \
2896                -command do_options
2897}
2898
2899# -- Tools Menu
2900#
2901if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2902        set tools_menubar .mbar.tools
2903        menu $tools_menubar
2904        $tools_menubar add separator
2905        $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2906        $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2907        set tools_tailcnt 3
2908        if {[array names repo_config guitool.*.cmd] ne {}} {
2909                tools_populate_all
2910        }
2911}
2912
2913# -- Help Menu
2914#
2915.mbar add cascade -label [mc Help] -menu .mbar.help
2916menu .mbar.help
2917
2918if {[is_MacOSX]} {
2919        .mbar.apple add command -label [mc "About %s" [appname]] \
2920                -command do_about
2921        .mbar.apple add separator
2922} else {
2923        .mbar.help add command -label [mc "About %s" [appname]] \
2924                -command do_about
2925}
2926. configure -menu .mbar
2927
2928set doc_path [githtmldir]
2929if {$doc_path ne {}} {
2930        set doc_path [file join $doc_path index.html]
2931
2932        if {[is_Cygwin]} {
2933                set doc_path [exec cygpath --mixed $doc_path]
2934        }
2935}
2936
2937if {[file isfile $doc_path]} {
2938        set doc_url "file:$doc_path"
2939} else {
2940        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2941}
2942
2943proc start_browser {url} {
2944        git "web--browse" $url
2945}
2946
2947.mbar.help add command -label [mc "Online Documentation"] \
2948        -command [list start_browser $doc_url]
2949
2950.mbar.help add command -label [mc "Show SSH Key"] \
2951        -command do_ssh_key
2952
2953unset doc_path doc_url
2954
2955# -- Standard bindings
2956#
2957wm protocol . WM_DELETE_WINDOW do_quit
2958bind all <$M1B-Key-q> do_quit
2959bind all <$M1B-Key-Q> do_quit
2960bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2961bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2962
2963set subcommand_args {}
2964proc usage {} {
2965        set s "usage: $::argv0 $::subcommand $::subcommand_args"
2966        if {[tk windowingsystem] eq "win32"} {
2967                wm withdraw .
2968                tk_messageBox -icon info -message $s \
2969                        -title [mc "Usage"]
2970        } else {
2971                puts stderr $s
2972        }
2973        exit 1
2974}
2975
2976proc normalize_relpath {path} {
2977        set elements {}
2978        foreach item [file split $path] {
2979                if {$item eq {.}} continue
2980                if {$item eq {..} && [llength $elements] > 0
2981                    && [lindex $elements end] ne {..}} {
2982                        set elements [lrange $elements 0 end-1]
2983                        continue
2984                }
2985                lappend elements $item
2986        }
2987        return [eval file join $elements]
2988}
2989
2990# -- Not a normal commit type invocation?  Do that instead!
2991#
2992switch -- $subcommand {
2993browser -
2994blame {
2995        if {$subcommand eq "blame"} {
2996                set subcommand_args {[--line=<num>] rev? path}
2997        } else {
2998                set subcommand_args {rev? path}
2999        }
3000        if {$argv eq {}} usage
3001        set head {}
3002        set path {}
3003        set jump_spec {}
3004        set is_path 0
3005        foreach a $argv {
3006                if {[file exists $a]} {
3007                        if {$path ne {}} usage
3008                        set path [normalize_relpath $a]
3009                        break
3010                } elseif {[file exists $_prefix$a]} {
3011                        if {$path ne {}} usage
3012                        set path [normalize_relpath $_prefix$a]
3013                        break
3014                }
3015
3016                if {$is_path} {
3017                        if {$path ne {}} usage
3018                        break
3019                } elseif {$a eq {--}} {
3020                        if {$path ne {}} {
3021                                if {$head ne {}} usage
3022                                set head $path
3023                                set path {}
3024                        }
3025                        set is_path 1
3026                } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
3027                        if {$jump_spec ne {} || $head ne {}} usage
3028                        set jump_spec [list $lnum]
3029                } elseif {$head eq {}} {
3030                        if {$head ne {}} usage
3031                        set head $a
3032                        set is_path 1
3033                } else {
3034                        usage
3035                }
3036        }
3037        unset is_path
3038
3039        if {$head ne {} && $path eq {}} {
3040                if {[string index $head 0] eq {/}} {
3041                        set path [normalize_relpath $head]
3042                        set head {}
3043                } else {
3044                        set path [normalize_relpath $_prefix$head]
3045                        set head {}
3046                }
3047        }
3048
3049        if {$head eq {}} {
3050                load_current_branch
3051        } else {
3052                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
3053                        if {[catch {
3054                                        set head [git rev-parse --verify $head]
3055                                } err]} {
3056                                if {[tk windowingsystem] eq "win32"} {
3057                                        tk_messageBox -icon error -title [mc Error] -message $err
3058                                } else {
3059                                        puts stderr $err
3060                                }
3061                                exit 1
3062                        }
3063                }
3064                set current_branch $head
3065        }
3066
3067        wm deiconify .
3068        switch -- $subcommand {
3069        browser {
3070                if {$jump_spec ne {}} usage
3071                if {$head eq {}} {
3072                        if {$path ne {} && [file isdirectory $path]} {
3073                                set head $current_branch
3074                        } else {
3075                                set head $path
3076                                set path {}
3077                        }
3078                }
3079                browser::new $head $path
3080        }
3081        blame   {
3082                if {$head eq {} && ![file exists $path]} {
3083                        catch {wm withdraw .}
3084                        tk_messageBox \
3085                                -icon error \
3086                                -type ok \
3087                                -title [mc "git-gui: fatal error"] \
3088                                -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
3089                        exit 1
3090                }
3091                blame::new $head $path $jump_spec
3092        }
3093        }
3094        return
3095}
3096citool -
3097gui {
3098        if {[llength $argv] != 0} {
3099                usage
3100        }
3101        # fall through to setup UI for commits
3102}
3103default {
3104        set err "usage: $argv0 \[{blame|browser|citool}\]"
3105        if {[tk windowingsystem] eq "win32"} {
3106                wm withdraw .
3107                tk_messageBox -icon error -message $err \
3108                        -title [mc "Usage"]
3109        } else {
3110                puts stderr $err
3111        }
3112        exit 1
3113}
3114}
3115
3116# -- Branch Control
3117#
3118${NS}::frame .branch
3119if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
3120${NS}::label .branch.l1 \
3121        -text [mc "Current Branch:"] \
3122        -anchor w \
3123        -justify left
3124${NS}::label .branch.cb \
3125        -textvariable current_branch \
3126        -anchor w \
3127        -justify left
3128pack .branch.l1 -side left
3129pack .branch.cb -side left -fill x
3130pack .branch -side top -fill x
3131
3132# -- Main Window Layout
3133#
3134${NS}::panedwindow .vpane -orient horizontal
3135${NS}::panedwindow .vpane.files -orient vertical
3136if {$use_ttk} {
3137        .vpane add .vpane.files
3138} else {
3139        .vpane add .vpane.files -sticky nsew -height 100 -width 200
3140}
3141pack .vpane -anchor n -side top -fill both -expand 1
3142
3143# -- Index File List
3144#
3145${NS}::frame .vpane.files.index -height 100 -width 200
3146tlabel .vpane.files.index.title \
3147        -text [mc "Staged Changes (Will Commit)"] \
3148        -background lightgreen -foreground black
3149text $ui_index -background white -foreground black \
3150        -borderwidth 0 \
3151        -width 20 -height 10 \
3152        -wrap none \
3153        -cursor $cursor_ptr \
3154        -xscrollcommand {.vpane.files.index.sx set} \
3155        -yscrollcommand {.vpane.files.index.sy set} \
3156        -state disabled
3157${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3158${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3159pack .vpane.files.index.title -side top -fill x
3160pack .vpane.files.index.sx -side bottom -fill x
3161pack .vpane.files.index.sy -side right -fill y
3162pack $ui_index -side left -fill both -expand 1
3163
3164# -- Working Directory File List
3165#
3166${NS}::frame .vpane.files.workdir -height 100 -width 200
3167tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3168        -background lightsalmon -foreground black
3169text $ui_workdir -background white -foreground black \
3170        -borderwidth 0 \
3171        -width 20 -height 10 \
3172        -wrap none \
3173        -cursor $cursor_ptr \
3174        -xscrollcommand {.vpane.files.workdir.sx set} \
3175        -yscrollcommand {.vpane.files.workdir.sy set} \
3176        -state disabled
3177${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3178${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3179pack .vpane.files.workdir.title -side top -fill x
3180pack .vpane.files.workdir.sx -side bottom -fill x
3181pack .vpane.files.workdir.sy -side right -fill y
3182pack $ui_workdir -side left -fill both -expand 1
3183
3184.vpane.files add .vpane.files.workdir
3185.vpane.files add .vpane.files.index
3186if {!$use_ttk} {
3187        .vpane.files paneconfigure .vpane.files.workdir -sticky news
3188        .vpane.files paneconfigure .vpane.files.index -sticky news
3189}
3190
3191foreach i [list $ui_index $ui_workdir] {
3192        rmsel_tag $i
3193        $i tag conf in_diff -background [$i tag cget in_sel -background]
3194}
3195unset i
3196
3197# -- Diff and Commit Area
3198#
3199${NS}::frame .vpane.lower -height 300 -width 400
3200${NS}::frame .vpane.lower.commarea
3201${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3202pack .vpane.lower.diff -fill both -expand 1
3203pack .vpane.lower.commarea -side bottom -fill x
3204.vpane add .vpane.lower
3205if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3206
3207# -- Commit Area Buttons
3208#
3209${NS}::frame .vpane.lower.commarea.buttons
3210${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3211        -anchor w \
3212        -justify left
3213pack .vpane.lower.commarea.buttons.l -side top -fill x
3214pack .vpane.lower.commarea.buttons -side left -fill y
3215
3216${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3217        -command ui_do_rescan
3218pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3219lappend disable_on_lock \
3220        {.vpane.lower.commarea.buttons.rescan conf -state}
3221
3222${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3223        -command do_add_all
3224pack .vpane.lower.commarea.buttons.incall -side top -fill x
3225lappend disable_on_lock \
3226        {.vpane.lower.commarea.buttons.incall conf -state}
3227
3228if {![is_enabled nocommitmsg]} {
3229        ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3230                -command do_signoff
3231        pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3232}
3233
3234${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3235        -command do_commit
3236pack .vpane.lower.commarea.buttons.commit -side top -fill x
3237lappend disable_on_lock \
3238        {.vpane.lower.commarea.buttons.commit conf -state}
3239
3240if {![is_enabled nocommit]} {
3241        ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3242                -command do_push_anywhere
3243        pack .vpane.lower.commarea.buttons.push -side top -fill x
3244}
3245
3246# -- Commit Message Buffer
3247#
3248${NS}::frame .vpane.lower.commarea.buffer
3249${NS}::frame .vpane.lower.commarea.buffer.header
3250set ui_comm .vpane.lower.commarea.buffer.t
3251set ui_coml .vpane.lower.commarea.buffer.header.l
3252
3253if {![is_enabled nocommit]} {
3254        ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3255                -text [mc "New Commit"] \
3256                -command do_select_commit_type \
3257                -variable selected_commit_type \
3258                -value new
3259        lappend disable_on_lock \
3260                [list .vpane.lower.commarea.buffer.header.new conf -state]
3261        ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3262                -text [mc "Amend Last Commit"] \
3263                -command do_select_commit_type \
3264                -variable selected_commit_type \
3265                -value amend
3266        lappend disable_on_lock \
3267                [list .vpane.lower.commarea.buffer.header.amend conf -state]
3268}
3269
3270${NS}::label $ui_coml \
3271        -anchor w \
3272        -justify left
3273proc trace_commit_type {varname args} {
3274        global ui_coml commit_type
3275        switch -glob -- $commit_type {
3276        initial       {set txt [mc "Initial Commit Message:"]}
3277        amend         {set txt [mc "Amended Commit Message:"]}
3278        amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3279        amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3280        merge         {set txt [mc "Merge Commit Message:"]}
3281        *             {set txt [mc "Commit Message:"]}
3282        }
3283        $ui_coml conf -text $txt
3284}
3285trace add variable commit_type write trace_commit_type
3286pack $ui_coml -side left -fill x
3287
3288if {![is_enabled nocommit]} {
3289        pack .vpane.lower.commarea.buffer.header.amend -side right
3290        pack .vpane.lower.commarea.buffer.header.new -side right
3291}
3292
3293text $ui_comm -background white -foreground black \
3294        -borderwidth 1 \
3295        -undo true \
3296        -maxundo 20 \
3297        -autoseparators true \
3298        -relief sunken \
3299        -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3300        -font font_diff \
3301        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3302${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3303        -command [list $ui_comm yview]
3304pack .vpane.lower.commarea.buffer.header -side top -fill x
3305pack .vpane.lower.commarea.buffer.sby -side right -fill y
3306pack $ui_comm -side left -fill y
3307pack .vpane.lower.commarea.buffer -side left -fill y
3308
3309# -- Commit Message Buffer Context Menu
3310#
3311set ctxm .vpane.lower.commarea.buffer.ctxm
3312menu $ctxm -tearoff 0
3313$ctxm add command \
3314        -label [mc Cut] \
3315        -command {tk_textCut $ui_comm}
3316$ctxm add command \
3317        -label [mc Copy] \
3318        -command {tk_textCopy $ui_comm}
3319$ctxm add command \
3320        -label [mc Paste] \
3321        -command {tk_textPaste $ui_comm}
3322$ctxm add command \
3323        -label [mc Delete] \
3324        -command {catch {$ui_comm delete sel.first sel.last}}
3325$ctxm add separator
3326$ctxm add command \
3327        -label [mc "Select All"] \
3328        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3329$ctxm add command \
3330        -label [mc "Copy All"] \
3331        -command {
3332                $ui_comm tag add sel 0.0 end
3333                tk_textCopy $ui_comm
3334                $ui_comm tag remove sel 0.0 end
3335        }
3336$ctxm add separator
3337$ctxm add command \
3338        -label [mc "Sign Off"] \
3339        -command do_signoff
3340set ui_comm_ctxm $ctxm
3341
3342# -- Diff Header
3343#
3344proc trace_current_diff_path {varname args} {
3345        global current_diff_path diff_actions file_states
3346        if {$current_diff_path eq {}} {
3347                set s {}
3348                set f {}
3349                set p {}
3350                set o disabled
3351        } else {
3352                set p $current_diff_path
3353                set s [mapdesc [lindex $file_states($p) 0] $p]
3354                set f [mc "File:"]
3355                set p [escape_path $p]
3356                set o normal
3357        }
3358
3359        .vpane.lower.diff.header.status configure -text $s
3360        .vpane.lower.diff.header.file configure -text $f
3361        .vpane.lower.diff.header.path configure -text $p
3362        foreach w $diff_actions {
3363                uplevel #0 $w $o
3364        }
3365}
3366trace add variable current_diff_path write trace_current_diff_path
3367
3368gold_frame .vpane.lower.diff.header
3369tlabel .vpane.lower.diff.header.status \
3370        -background gold \
3371        -foreground black \
3372        -width $max_status_desc \
3373        -anchor w \
3374        -justify left
3375tlabel .vpane.lower.diff.header.file \
3376        -background gold \
3377        -foreground black \
3378        -anchor w \
3379        -justify left
3380tlabel .vpane.lower.diff.header.path \
3381        -background gold \
3382        -foreground black \
3383        -anchor w \
3384        -justify left
3385pack .vpane.lower.diff.header.status -side left
3386pack .vpane.lower.diff.header.file -side left
3387pack .vpane.lower.diff.header.path -fill x
3388set ctxm .vpane.lower.diff.header.ctxm
3389menu $ctxm -tearoff 0
3390$ctxm add command \
3391        -label [mc Copy] \
3392        -command {
3393                clipboard clear
3394                clipboard append \
3395                        -format STRING \
3396                        -type STRING \
3397                        -- $current_diff_path
3398        }
3399lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3400bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3401
3402# -- Diff Body
3403#
3404${NS}::frame .vpane.lower.diff.body
3405set ui_diff .vpane.lower.diff.body.t
3406text $ui_diff -background white -foreground black \
3407        -borderwidth 0 \
3408        -width 80 -height 5 -wrap none \
3409        -font font_diff \
3410        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3411        -yscrollcommand {.vpane.lower.diff.body.sby set} \
3412        -state disabled
3413catch {$ui_diff configure -tabstyle wordprocessor}
3414${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3415        -command [list $ui_diff xview]
3416${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3417        -command [list $ui_diff yview]
3418pack .vpane.lower.diff.body.sbx -side bottom -fill x
3419pack .vpane.lower.diff.body.sby -side right -fill y
3420pack $ui_diff -side left -fill both -expand 1
3421pack .vpane.lower.diff.header -side top -fill x
3422pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3423
3424foreach {n c} {0 black 1 red4 2 green4 3 yellow4 4 blue4 5 magenta4 6 cyan4 7 grey60} {
3425        $ui_diff tag configure clr4$n -background $c
3426        $ui_diff tag configure clri4$n -foreground $c
3427        $ui_diff tag configure clr3$n -foreground $c
3428        $ui_diff tag configure clri3$n -background $c
3429}
3430$ui_diff tag configure clr1 -font font_diffbold
3431$ui_diff tag configure clr4 -underline 1
3432
3433$ui_diff tag conf d_info -foreground blue -font font_diffbold
3434
3435$ui_diff tag conf d_cr -elide true
3436$ui_diff tag conf d_@ -font font_diffbold
3437$ui_diff tag conf d_+ -foreground {#00a000}
3438$ui_diff tag conf d_- -foreground red
3439
3440$ui_diff tag conf d_++ -foreground {#00a000}
3441$ui_diff tag conf d_-- -foreground red
3442$ui_diff tag conf d_+s \
3443        -foreground {#00a000} \
3444        -background {#e2effa}
3445$ui_diff tag conf d_-s \
3446        -foreground red \
3447        -background {#e2effa}
3448$ui_diff tag conf d_s+ \
3449        -foreground {#00a000} \
3450        -background ivory1
3451$ui_diff tag conf d_s- \
3452        -foreground red \
3453        -background ivory1
3454
3455$ui_diff tag conf d< \
3456        -foreground orange \
3457        -font font_diffbold
3458$ui_diff tag conf d= \
3459        -foreground orange \
3460        -font font_diffbold
3461$ui_diff tag conf d> \
3462        -foreground orange \
3463        -font font_diffbold
3464
3465$ui_diff tag raise sel
3466
3467# -- Diff Body Context Menu
3468#
3469
3470proc create_common_diff_popup {ctxm} {
3471        $ctxm add command \
3472                -label [mc Refresh] \
3473                -command reshow_diff
3474        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3475        $ctxm add command \
3476                -label [mc Copy] \
3477                -command {tk_textCopy $ui_diff}
3478        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3479        $ctxm add command \
3480                -label [mc "Select All"] \
3481                -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3482        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3483        $ctxm add command \
3484                -label [mc "Copy All"] \
3485                -command {
3486                        $ui_diff tag add sel 0.0 end
3487                        tk_textCopy $ui_diff
3488                        $ui_diff tag remove sel 0.0 end
3489                }
3490        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3491        $ctxm add separator
3492        $ctxm add command \
3493                -label [mc "Decrease Font Size"] \
3494                -command {incr_font_size font_diff -1}
3495        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3496        $ctxm add command \
3497                -label [mc "Increase Font Size"] \
3498                -command {incr_font_size font_diff 1}
3499        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3500        $ctxm add separator
3501        set emenu $ctxm.enc
3502        menu $emenu
3503        build_encoding_menu $emenu [list force_diff_encoding]
3504        $ctxm add cascade \
3505                -label [mc "Encoding"] \
3506                -menu $emenu
3507        lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3508        $ctxm add separator
3509        $ctxm add command -label [mc "Options..."] \
3510                -command do_options
3511}
3512
3513set ctxm .vpane.lower.diff.body.ctxm
3514menu $ctxm -tearoff 0
3515$ctxm add command \
3516        -label [mc "Apply/Reverse Hunk"] \
3517        -command {apply_hunk $cursorX $cursorY}
3518set ui_diff_applyhunk [$ctxm index last]
3519lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3520$ctxm add command \
3521        -label [mc "Apply/Reverse Line"] \
3522        -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3523set ui_diff_applyline [$ctxm index last]
3524lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3525$ctxm add separator
3526$ctxm add command \
3527        -label [mc "Show Less Context"] \
3528        -command show_less_context
3529lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3530$ctxm add command \
3531        -label [mc "Show More Context"] \
3532        -command show_more_context
3533lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3534$ctxm add separator
3535create_common_diff_popup $ctxm
3536
3537set ctxmmg .vpane.lower.diff.body.ctxmmg
3538menu $ctxmmg -tearoff 0
3539$ctxmmg add command \
3540        -label [mc "Run Merge Tool"] \
3541        -command {merge_resolve_tool}
3542lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3543$ctxmmg add separator
3544$ctxmmg add command \
3545        -label [mc "Use Remote Version"] \
3546        -command {merge_resolve_one 3}
3547lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3548$ctxmmg add command \
3549        -label [mc "Use Local Version"] \
3550        -command {merge_resolve_one 2}
3551lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3552$ctxmmg add command \
3553        -label [mc "Revert To Base"] \
3554        -command {merge_resolve_one 1}
3555lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3556$ctxmmg add separator
3557$ctxmmg add command \
3558        -label [mc "Show Less Context"] \
3559        -command show_less_context
3560lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3561$ctxmmg add command \
3562        -label [mc "Show More Context"] \
3563        -command show_more_context
3564lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3565$ctxmmg add separator
3566create_common_diff_popup $ctxmmg
3567
3568set ctxmsm .vpane.lower.diff.body.ctxmsm
3569menu $ctxmsm -tearoff 0
3570$ctxmsm add command \
3571        -label [mc "Visualize These Changes In The Submodule"] \
3572        -command {do_gitk -- true}
3573lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3574$ctxmsm add command \
3575        -label [mc "Visualize Current Branch History In The Submodule"] \
3576        -command {do_gitk {} true}
3577lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3578$ctxmsm add command \
3579        -label [mc "Visualize All Branch History In The Submodule"] \
3580        -command {do_gitk --all true}
3581lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3582$ctxmsm add separator
3583$ctxmsm add command \
3584        -label [mc "Start git gui In The Submodule"] \
3585        -command {do_git_gui}
3586lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3587$ctxmsm add separator
3588create_common_diff_popup $ctxmsm
3589
3590proc has_textconv {path} {
3591        if {[is_config_false gui.textconv]} {
3592                return 0
3593        }
3594        set filter [gitattr $path diff set]
3595        set textconv [get_config [join [list diff $filter textconv] .]]
3596        if {$filter ne {set} && $textconv ne {}} {
3597                return 1
3598        } else {
3599                return 0
3600        }
3601}
3602
3603proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3604        global current_diff_path file_states
3605        set ::cursorX $x
3606        set ::cursorY $y
3607        if {[info exists file_states($current_diff_path)]} {
3608                set state [lindex $file_states($current_diff_path) 0]
3609        } else {
3610                set state {__}
3611        }
3612        if {[string first {U} $state] >= 0} {
3613                tk_popup $ctxmmg $X $Y
3614        } elseif {$::is_submodule_diff} {
3615                tk_popup $ctxmsm $X $Y
3616        } else {
3617                set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3618                if {$::ui_index eq $::current_diff_side} {
3619                        set l [mc "Unstage Hunk From Commit"]
3620                        if {$has_range} {
3621                                set t [mc "Unstage Lines From Commit"]
3622                        } else {
3623                                set t [mc "Unstage Line From Commit"]
3624                        }
3625                } else {
3626                        set l [mc "Stage Hunk For Commit"]
3627                        if {$has_range} {
3628                                set t [mc "Stage Lines For Commit"]
3629                        } else {
3630                                set t [mc "Stage Line For Commit"]
3631                        }
3632                }
3633                if {$::is_3way_diff
3634                        || $current_diff_path eq {}
3635                        || {__} eq $state
3636                        || {_O} eq $state
3637                        || [string match {?T} $state]
3638                        || [string match {T?} $state]
3639                        || [has_textconv $current_diff_path]} {
3640                        set s disabled
3641                } else {
3642                        set s normal
3643                }
3644                $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3645                $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3646                tk_popup $ctxm $X $Y
3647        }
3648}
3649bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3650
3651# -- Status Bar
3652#
3653set main_status [::status_bar::new .status]
3654pack .status -anchor w -side bottom -fill x
3655$main_status show [mc "Initializing..."]
3656
3657# -- Load geometry
3658#
3659proc on_ttk_pane_mapped {w pane pos} {
3660        bind $w <Map> {}
3661        after 0 [list after idle [list $w sashpos $pane $pos]]
3662}
3663proc on_tk_pane_mapped {w pane x y} {
3664        bind $w <Map> {}
3665        after 0 [list after idle [list $w sash place $pane $x $y]]
3666}
3667proc on_application_mapped {} {
3668        global repo_config use_ttk
3669        bind . <Map> {}
3670        set gm $repo_config(gui.geometry)
3671        if {$use_ttk} {
3672                bind .vpane <Map> \
3673                    [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3674                bind .vpane.files <Map> \
3675                    [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3676        } else {
3677                bind .vpane <Map> \
3678                    [list on_tk_pane_mapped %W 0 \
3679                         [lindex $gm 1] \
3680                         [lindex [.vpane sash coord 0] 1]]
3681                bind .vpane.files <Map> \
3682                    [list on_tk_pane_mapped %W 0 \
3683                         [lindex [.vpane.files sash coord 0] 0] \
3684                         [lindex $gm 2]]
3685        }
3686        wm geometry . [lindex $gm 0]
3687}
3688if {[info exists repo_config(gui.geometry)]} {
3689        bind . <Map> [list on_application_mapped]
3690        wm geometry . [lindex $repo_config(gui.geometry) 0]
3691}
3692
3693# -- Load window state
3694#
3695if {[info exists repo_config(gui.wmstate)]} {
3696        catch {wm state . $repo_config(gui.wmstate)}
3697}
3698
3699# -- Key Bindings
3700#
3701bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3702bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3703bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3704bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3705bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3706bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3707bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3708bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3709bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3710bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3711bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3712bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3713bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3714bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3715bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3716bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3717bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3718bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3719bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3720bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3721bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3722bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3723
3724bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3725bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3726bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3727bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3728bind $ui_diff <$M1B-Key-v> {break}
3729bind $ui_diff <$M1B-Key-V> {break}
3730bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3731bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3732bind $ui_diff <$M1B-Key-j> {do_revert_selection;break}
3733bind $ui_diff <$M1B-Key-J> {do_revert_selection;break}
3734bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3735bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3736bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3737bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3738bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3739bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3740bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3741bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3742bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3743bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3744bind $ui_diff <Button-1>   {focus %W}
3745
3746if {[is_enabled branch]} {
3747        bind . <$M1B-Key-n> branch_create::dialog
3748        bind . <$M1B-Key-N> branch_create::dialog
3749        bind . <$M1B-Key-o> branch_checkout::dialog
3750        bind . <$M1B-Key-O> branch_checkout::dialog
3751        bind . <$M1B-Key-m> merge::dialog
3752        bind . <$M1B-Key-M> merge::dialog
3753}
3754if {[is_enabled transport]} {
3755        bind . <$M1B-Key-p> do_push_anywhere
3756        bind . <$M1B-Key-P> do_push_anywhere
3757}
3758
3759bind .   <Key-F5>     ui_do_rescan
3760bind .   <$M1B-Key-r> ui_do_rescan
3761bind .   <$M1B-Key-R> ui_do_rescan
3762bind .   <$M1B-Key-s> do_signoff
3763bind .   <$M1B-Key-S> do_signoff
3764bind .   <$M1B-Key-t> do_add_selection
3765bind .   <$M1B-Key-T> do_add_selection
3766bind .   <$M1B-Key-u> do_unstage_selection
3767bind .   <$M1B-Key-U> do_unstage_selection
3768bind .   <$M1B-Key-j> do_revert_selection
3769bind .   <$M1B-Key-J> do_revert_selection
3770bind .   <$M1B-Key-i> do_add_all
3771bind .   <$M1B-Key-I> do_add_all
3772bind .   <$M1B-Key-minus> {show_less_context;break}
3773bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3774bind .   <$M1B-Key-equal> {show_more_context;break}
3775bind .   <$M1B-Key-plus> {show_more_context;break}
3776bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3777bind .   <$M1B-Key-Return> do_commit
3778foreach i [list $ui_index $ui_workdir] {
3779        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3780        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3781        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3782}
3783unset i
3784
3785set file_lists($ui_index) [list]
3786set file_lists($ui_workdir) [list]
3787
3788wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3789focus -force $ui_comm
3790
3791# -- Warn the user about environmental problems.  Cygwin's Tcl
3792#    does *not* pass its env array onto any processes it spawns.
3793#    This means that git processes get none of our environment.
3794#
3795if {[is_Cygwin]} {
3796        set ignored_env 0
3797        set suggest_user {}
3798        set msg [mc "Possible environment issues exist.
3799
3800The following environment variables are probably
3801going to be ignored by any Git subprocess run
3802by %s:
3803
3804" [appname]]
3805        foreach name [array names env] {
3806                switch -regexp -- $name {
3807                {^GIT_INDEX_FILE$} -
3808                {^GIT_OBJECT_DIRECTORY$} -
3809                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3810                {^GIT_DIFF_OPTS$} -
3811                {^GIT_EXTERNAL_DIFF$} -
3812                {^GIT_PAGER$} -
3813                {^GIT_TRACE$} -
3814                {^GIT_CONFIG$} -
3815                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3816                        append msg " - $name\n"
3817                        incr ignored_env
3818                }
3819                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3820                        append msg " - $name\n"
3821                        incr ignored_env
3822                        set suggest_user $name
3823                }
3824                }
3825        }
3826        if {$ignored_env > 0} {
3827                append msg [mc "
3828This is due to a known issue with the
3829Tcl binary distributed by Cygwin."]
3830
3831                if {$suggest_user ne {}} {
3832                        append msg [mc "
3833
3834A good replacement for %s
3835is placing values for the user.name and
3836user.email settings into your personal
3837~/.gitconfig file.
3838" $suggest_user]
3839                }
3840                warn_popup $msg
3841        }
3842        unset ignored_env msg suggest_user name
3843}
3844
3845# -- Only initialize complex UI if we are going to stay running.
3846#
3847if {[is_enabled transport]} {
3848        load_all_remotes
3849
3850        set n [.mbar.remote index end]
3851        populate_remotes_menu
3852        set n [expr {[.mbar.remote index end] - $n}]
3853        if {$n > 0} {
3854                if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3855                .mbar.remote insert $n separator
3856        }
3857        unset n
3858}
3859
3860if {[winfo exists $ui_comm]} {
3861        set GITGUI_BCK_exists [load_message GITGUI_BCK utf-8]
3862
3863        # -- If both our backup and message files exist use the
3864        #    newer of the two files to initialize the buffer.
3865        #
3866        if {$GITGUI_BCK_exists} {
3867                set m [gitdir GITGUI_MSG]
3868                if {[file isfile $m]} {
3869                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3870                                catch {file delete [gitdir GITGUI_MSG]}
3871                        } else {
3872                                $ui_comm delete 0.0 end
3873                                $ui_comm edit reset
3874                                $ui_comm edit modified false
3875                                catch {file delete [gitdir GITGUI_BCK]}
3876                                set GITGUI_BCK_exists 0
3877                        }
3878                }
3879                unset m
3880        }
3881
3882        proc backup_commit_buffer {} {
3883                global ui_comm GITGUI_BCK_exists
3884
3885                set m [$ui_comm edit modified]
3886                if {$m || $GITGUI_BCK_exists} {
3887                        set msg [string trim [$ui_comm get 0.0 end]]
3888                        regsub -all -line {[ \r\t]+$} $msg {} msg
3889
3890                        if {$msg eq {}} {
3891                                if {$GITGUI_BCK_exists} {
3892                                        catch {file delete [gitdir GITGUI_BCK]}
3893                                        set GITGUI_BCK_exists 0
3894                                }
3895                        } elseif {$m} {
3896                                catch {
3897                                        set fd [open [gitdir GITGUI_BCK] w]
3898                                        fconfigure $fd -encoding utf-8
3899                                        puts -nonewline $fd $msg
3900                                        close $fd
3901                                        set GITGUI_BCK_exists 1
3902                                }
3903                        }
3904
3905                        $ui_comm edit modified false
3906                }
3907
3908                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3909        }
3910
3911        backup_commit_buffer
3912
3913        # -- If the user has aspell available we can drive it
3914        #    in pipe mode to spellcheck the commit message.
3915        #
3916        set spell_cmd [list |]
3917        set spell_dict [get_config gui.spellingdictionary]
3918        lappend spell_cmd aspell
3919        if {$spell_dict ne {}} {
3920                lappend spell_cmd --master=$spell_dict
3921        }
3922        lappend spell_cmd --mode=none
3923        lappend spell_cmd --encoding=utf-8
3924        lappend spell_cmd pipe
3925        if {$spell_dict eq {none}
3926         || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3927                bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3928        } else {
3929                set ui_comm_spell [spellcheck::init \
3930                        $spell_fd \
3931                        $ui_comm \
3932                        $ui_comm_ctxm \
3933                ]
3934        }
3935        unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3936}
3937
3938lock_index begin-read
3939if {![winfo ismapped .]} {
3940        wm deiconify .
3941}
3942after 1 {
3943        if {[is_enabled initialamend]} {
3944                force_amend
3945        } else {
3946                do_rescan
3947        }
3948
3949        if {[is_enabled nocommitmsg]} {
3950                $ui_comm configure -state disabled -background gray
3951        }
3952}
3953if {[is_enabled multicommit] && ![is_config_false gui.gcwarning]} {
3954        after 1000 hint_gc
3955}
3956if {[is_enabled retcode]} {
3957        bind . <Destroy> {+terminate_me %W}
3958}
3959if {$picked && [is_config_true gui.autoexplore]} {
3960        do_explore
3961}
3962
3963# Local variables:
3964# mode: tcl
3965# indent-tabs-mode: t
3966# tab-width: 4
3967# End: