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