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