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