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