Andrew's git - gitweb.git/blob - git-gui/git-gui.sh

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