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