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