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