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