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