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