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