Andrew's git - gitweb.git/blob

   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3 if test "z$*" = zversion \
   4 || test "z$*" = z--version; \
   5 then \
   6        echo 'git-gui version @@GITGUI_VERSION@@'; \
   7        exit; \
   8 fi; \
   9 argv0=$0; \
  10 exec wish "$argv0" -- "$@"
  11
  12set appvers {@@GITGUI_VERSION@@}
  13set copyright [encoding convertfrom utf-8 {
  14Copyright © 2006, 2007 Shawn Pearce, et. al.
  15
  16This program is free software; you can redistribute it and/or modify
  17it under the terms of the GNU General Public License as published by
  18the Free Software Foundation; either version 2 of the License, or
  19(at your option) any later version.
  20
  21This program is distributed in the hope that it will be useful,
  22but WITHOUT ANY WARRANTY; without even the implied warranty of
  23MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  24GNU General Public License for more details.
  25
  26You should have received a copy of the GNU General Public License
  27along with this program; if not, write to the Free Software
  28Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}]
  29
  30######################################################################
  31##
  32## Tcl/Tk sanity check
  33
  34if {[catch {package require Tcl 8.4} err]
  35 || [catch {package require Tk  8.4} err]
  36} {
  37        catch {wm withdraw .}
  38        tk_messageBox \
  39                -icon error \
  40                -type ok \
  41                -title [mc "git-gui: fatal error"] \
  42                -message $err
  43        exit 1
  44}
  45
  46catch {rename send {}} ; # What an evil concept...
  47
  48######################################################################
  49##
  50## locate our library
  51
  52set oguilib {@@GITGUI_LIBDIR@@}
  53set oguirel {@@GITGUI_RELATIVE@@}
  54if {$oguirel eq {1}} {
  55        set oguilib [file dirname [file normalize $argv0]]
  56        if {[file tail $oguilib] eq {git-core}} {
  57                set oguilib [file dirname $oguilib]
  58        }
  59        set oguilib [file dirname $oguilib]
  60        set oguilib [file join $oguilib share git-gui lib]
  61        set oguimsg [file join $oguilib msgs]
  62} elseif {[string match @@* $oguirel]} {
  63        set oguilib [file join [file dirname [file normalize $argv0]] lib]
  64        set oguimsg [file join [file dirname [file normalize $argv0]] po]
  65} else {
  66        set oguimsg [file join $oguilib msgs]
  67}
  68unset oguirel
  69
  70######################################################################
  71##
  72## enable verbose loading?
  73
  74if {![catch {set _verbose $env(GITGUI_VERBOSE)}]} {
  75        unset _verbose
  76        rename auto_load real__auto_load
  77        proc auto_load {name args} {
  78                puts stderr "auto_load $name"
  79                return [uplevel 1 real__auto_load $name $args]
  80        }
  81        rename source real__source
  82        proc source {name} {
  83                puts stderr "source    $name"
  84                uplevel 1 real__source $name
  85        }
  86}
  87
  88######################################################################
  89##
  90## Internationalization (i18n) through msgcat and gettext. See
  91## http://www.gnu.org/software/gettext/manual/html_node/Tcl.html
  92
  93package require msgcat
  94
  95proc _mc_trim {fmt} {
  96        set cmk [string first @@ $fmt]
  97        if {$cmk > 0} {
  98                return [string range $fmt 0 [expr {$cmk - 1}]]
  99        }
 100        return $fmt
 101}
 102
 103proc mc {en_fmt args} {
 104        set fmt [_mc_trim [::msgcat::mc $en_fmt]]
 105        if {[catch {set msg [eval [list format $fmt] $args]} err]} {
 106                set msg [eval [list format [_mc_trim $en_fmt]] $args]
 107        }
 108        return $msg
 109}
 110
 111proc strcat {args} {
 112        return [join $args {}]
 113}
 114
 115::msgcat::mcload $oguimsg
 116unset oguimsg
 117
 118######################################################################
 119##
 120## read only globals
 121
 122set _appname {Git Gui}
 123set _gitdir {}
 124set _gitexec {}
 125set _reponame {}
 126set _iscygwin {}
 127set _search_path {}
 128
 129set _trace [lsearch -exact $argv --trace]
 130if {$_trace >= 0} {
 131        set argv [lreplace $argv $_trace $_trace]
 132        set _trace 1
 133} else {
 134        set _trace 0
 135}
 136
 137proc appname {} {
 138        global _appname
 139        return $_appname
 140}
 141
 142proc gitdir {args} {
 143        global _gitdir
 144        if {$args eq {}} {
 145                return $_gitdir
 146        }
 147        return [eval [list file join $_gitdir] $args]
 148}
 149
 150proc gitexec {args} {
 151        global _gitexec
 152        if {$_gitexec eq {}} {
 153                if {[catch {set _gitexec [git --exec-path]} err]} {
 154                        error "Git not installed?\n\n$err"
 155                }
 156                if {[is_Cygwin]} {
 157                        set _gitexec [exec cygpath \
 158                                --windows \
 159                                --absolute \
 160                                $_gitexec]
 161                } else {
 162                        set _gitexec [file normalize $_gitexec]
 163                }
 164        }
 165        if {$args eq {}} {
 166                return $_gitexec
 167        }
 168        return [eval [list file join $_gitexec] $args]
 169}
 170
 171proc reponame {} {
 172        return $::_reponame
 173}
 174
 175proc is_MacOSX {} {
 176        if {[tk windowingsystem] eq {aqua}} {
 177                return 1
 178        }
 179        return 0
 180}
 181
 182proc is_Windows {} {
 183        if {$::tcl_platform(platform) eq {windows}} {
 184                return 1
 185        }
 186        return 0
 187}
 188
 189proc is_Cygwin {} {
 190        global _iscygwin
 191        if {$_iscygwin eq {}} {
 192                if {$::tcl_platform(platform) eq {windows}} {
 193                        if {[catch {set p [exec cygpath --windir]} err]} {
 194                                set _iscygwin 0
 195                        } else {
 196                                set _iscygwin 1
 197                        }
 198                } else {
 199                        set _iscygwin 0
 200                }
 201        }
 202        return $_iscygwin
 203}
 204
 205proc is_enabled {option} {
 206        global enabled_options
 207        if {[catch {set on $enabled_options($option)}]} {return 0}
 208        return $on
 209}
 210
 211proc enable_option {option} {
 212        global enabled_options
 213        set enabled_options($option) 1
 214}
 215
 216proc disable_option {option} {
 217        global enabled_options
 218        set enabled_options($option) 0
 219}
 220
 221######################################################################
 222##
 223## config
 224
 225proc is_many_config {name} {
 226        switch -glob -- $name {
 227        gui.recentrepo -
 228        remote.*.fetch -
 229        remote.*.push
 230                {return 1}
 231        *
 232                {return 0}
 233        }
 234}
 235
 236proc is_config_true {name} {
 237        global repo_config
 238        if {[catch {set v $repo_config($name)}]} {
 239                return 0
 240        } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 241                return 1
 242        } else {
 243                return 0
 244        }
 245}
 246
 247proc get_config {name} {
 248        global repo_config
 249        if {[catch {set v $repo_config($name)}]} {
 250                return {}
 251        } else {
 252                return $v
 253        }
 254}
 255
 256######################################################################
 257##
 258## handy utils
 259
 260proc _trace_exec {cmd} {
 261        if {!$::_trace} return
 262        set d {}
 263        foreach v $cmd {
 264                if {$d ne {}} {
 265                        append d { }
 266                }
 267                if {[regexp {[ \t\r\n'"$?*]} $v]} {
 268                        set v [sq $v]
 269                }
 270                append d $v
 271        }
 272        puts stderr $d
 273}
 274
 275proc _git_cmd {name} {
 276        global _git_cmd_path
 277
 278        if {[catch {set v $_git_cmd_path($name)}]} {
 279                switch -- $name {
 280                  version   -
 281                --version   -
 282                --exec-path { return [list $::_git $name] }
 283                }
 284
 285                set p [gitexec git-$name$::_search_exe]
 286                if {[file exists $p]} {
 287                        set v [list $p]
 288                } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 289                        # Try to determine what sort of magic will make
 290                        # git-$name go and do its thing, because native
 291                        # Tcl on Windows doesn't know it.
 292                        #
 293                        set p [gitexec git-$name]
 294                        set f [open $p r]
 295                        set s [gets $f]
 296                        close $f
 297
 298                        switch -glob -- [lindex $s 0] {
 299                        #!*sh     { set i sh     }
 300                        #!*perl   { set i perl   }
 301                        #!*python { set i python }
 302                        default   { error "git-$name is not supported: $s" }
 303                        }
 304
 305                        upvar #0 _$i interp
 306                        if {![info exists interp]} {
 307                                set interp [_which $i]
 308                        }
 309                        if {$interp eq {}} {
 310                                error "git-$name requires $i (not in PATH)"
 311                        }
 312                        set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 313                } else {
 314                        # Assume it is builtin to git somehow and we
 315                        # aren't actually able to see a file for it.
 316                        #
 317                        set v [list $::_git $name]
 318                }
 319                set _git_cmd_path($name) $v
 320        }
 321        return $v
 322}
 323
 324proc _which {what args} {
 325        global env _search_exe _search_path
 326
 327        if {$_search_path eq {}} {
 328                if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
 329                        set _search_path [split [exec cygpath \
 330                                --windows \
 331                                --path \
 332                                --absolute \
 333                                $env(PATH)] {;}]
 334                        set _search_exe .exe
 335                } elseif {[is_Windows]} {
 336                        set gitguidir [file dirname [info script]]
 337                        regsub -all ";" $gitguidir "\\;" gitguidir
 338                        set env(PATH) "$gitguidir;$env(PATH)"
 339                        set _search_path [split $env(PATH) {;}]
 340                        set _search_exe .exe
 341                } else {
 342                        set _search_path [split $env(PATH) :]
 343                        set _search_exe {}
 344                }
 345        }
 346
 347        if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
 348                set suffix {}
 349        } else {
 350                set suffix $_search_exe
 351        }
 352
 353        foreach p $_search_path {
 354                set p [file join $p $what$suffix]
 355                if {[file exists $p]} {
 356                        return [file normalize $p]
 357                }
 358        }
 359        return {}
 360}
 361
 362proc _lappend_nice {cmd_var} {
 363        global _nice
 364        upvar $cmd_var cmd
 365
 366        if {![info exists _nice]} {
 367                set _nice [_which nice]
 368        }
 369        if {$_nice ne {}} {
 370                lappend cmd $_nice
 371        }
 372}
 373
 374proc git {args} {
 375        set opt [list]
 376
 377        while {1} {
 378                switch -- [lindex $args 0] {
 379                --nice {
 380                        _lappend_nice opt
 381                }
 382
 383                default {
 384                        break
 385                }
 386
 387                }
 388
 389                set args [lrange $args 1 end]
 390        }
 391
 392        set cmdp [_git_cmd [lindex $args 0]]
 393        set args [lrange $args 1 end]
 394
 395        _trace_exec [concat $opt $cmdp $args]
 396        set result [eval exec $opt $cmdp $args]
 397        if {$::_trace} {
 398                puts stderr "< $result"
 399        }
 400        return $result
 401}
 402
 403proc _open_stdout_stderr {cmd} {
 404        _trace_exec $cmd
 405        if {[catch {
 406                        set fd [open [concat [list | ] $cmd] r]
 407                } err]} {
 408                if {   [lindex $cmd end] eq {2>@1}
 409                    && $err eq {can not find channel named "1"}
 410                        } {
 411                        # Older versions of Tcl 8.4 don't have this 2>@1 IO
 412                        # redirect operator.  Fallback to |& cat for those.
 413                        # The command was not actually started, so its safe
 414                        # to try to start it a second time.
 415                        #
 416                        set fd [open [concat \
 417                                [list | ] \
 418                                [lrange $cmd 0 end-1] \
 419                                [list |& cat] \
 420                                ] r]
 421                } else {
 422                        error $err
 423                }
 424        }
 425        fconfigure $fd -eofchar {}
 426        return $fd
 427}
 428
 429proc git_read {args} {
 430        set opt [list]
 431
 432        while {1} {
 433                switch -- [lindex $args 0] {
 434                --nice {
 435                        _lappend_nice opt
 436                }
 437
 438                --stderr {
 439                        lappend args 2>@1
 440                }
 441
 442                default {
 443                        break
 444                }
 445
 446                }
 447
 448                set args [lrange $args 1 end]
 449        }
 450
 451        set cmdp [_git_cmd [lindex $args 0]]
 452        set args [lrange $args 1 end]
 453
 454        return [_open_stdout_stderr [concat $opt $cmdp $args]]
 455}
 456
 457proc git_write {args} {
 458        set opt [list]
 459
 460        while {1} {
 461                switch -- [lindex $args 0] {
 462                --nice {
 463                        _lappend_nice opt
 464                }
 465
 466                default {
 467                        break
 468                }
 469
 470                }
 471
 472                set args [lrange $args 1 end]
 473        }
 474
 475        set cmdp [_git_cmd [lindex $args 0]]
 476        set args [lrange $args 1 end]
 477
 478        _trace_exec [concat $opt $cmdp $args]
 479        return [open [concat [list | ] $opt $cmdp $args] w]
 480}
 481
 482proc githook_read {hook_name args} {
 483        set pchook [gitdir hooks $hook_name]
 484        lappend args 2>@1
 485
 486        # On Windows [file executable] might lie so we need to ask
 487        # the shell if the hook is executable.  Yes that's annoying.
 488        #
 489        if {[is_Windows]} {
 490                upvar #0 _sh interp
 491                if {![info exists interp]} {
 492                        set interp [_which sh]
 493                }
 494                if {$interp eq {}} {
 495                        error "hook execution requires sh (not in PATH)"
 496                }
 497
 498                set scr {if test -x "$1";then exec "$@";fi}
 499                set sh_c [list $interp -c $scr $interp $pchook]
 500                return [_open_stdout_stderr [concat $sh_c $args]]
 501        }
 502
 503        if {[file executable $pchook]} {
 504                return [_open_stdout_stderr [concat [list $pchook] $args]]
 505        }
 506
 507        return {}
 508}
 509
 510proc kill_file_process {fd} {
 511        set process [pid $fd]
 512
 513        catch {
 514                if {[is_Windows]} {
 515                        # Use a Cygwin-specific flag to allow killing
 516                        # native Windows processes
 517                        exec kill -f $process
 518                } else {
 519                        exec kill $process
 520                }
 521        }
 522}
 523
 524proc sq {value} {
 525        regsub -all ' $value "'\\''" value
 526        return "'$value'"
 527}
 528
 529proc load_current_branch {} {
 530        global current_branch is_detached
 531
 532        set fd [open [gitdir HEAD] r]
 533        if {[gets $fd ref] < 1} {
 534                set ref {}
 535        }
 536        close $fd
 537
 538        set pfx {ref: refs/heads/}
 539        set len [string length $pfx]
 540        if {[string equal -length $len $pfx $ref]} {
 541                # We're on a branch.  It might not exist.  But
 542                # HEAD looks good enough to be a branch.
 543                #
 544                set current_branch [string range $ref $len end]
 545                set is_detached 0
 546        } else {
 547                # Assume this is a detached head.
 548                #
 549                set current_branch HEAD
 550                set is_detached 1
 551        }
 552}
 553
 554auto_load tk_optionMenu
 555rename tk_optionMenu real__tkOptionMenu
 556proc tk_optionMenu {w varName args} {
 557        set m [eval real__tkOptionMenu $w $varName $args]
 558        $m configure -font font_ui
 559        $w configure -font font_ui
 560        return $m
 561}
 562
 563proc rmsel_tag {text} {
 564        $text tag conf sel \
 565                -background [$text cget -background] \
 566                -foreground [$text cget -foreground] \
 567                -borderwidth 0
 568        $text tag conf in_sel -background lightgray
 569        bind $text <Motion> break
 570        return $text
 571}
 572
 573set root_exists 0
 574bind . <Visibility> {
 575        bind . <Visibility> {}
 576        set root_exists 1
 577}
 578
 579if {[is_Windows]} {
 580        wm iconbitmap . -default $oguilib/git-gui.ico
 581}
 582
 583######################################################################
 584##
 585## config defaults
 586
 587set cursor_ptr arrow
 588font create font_diff -family Courier -size 10
 589font create font_ui
 590catch {
 591        label .dummy
 592        eval font configure font_ui [font actual [.dummy cget -font]]
 593        destroy .dummy
 594}
 595
 596font create font_uiitalic
 597font create font_uibold
 598font create font_diffbold
 599font create font_diffitalic
 600
 601foreach class {Button Checkbutton Entry Label
 602                Labelframe Listbox Menu Message
 603                Radiobutton Spinbox Text} {
 604        option add *$class.font font_ui
 605}
 606unset class
 607
 608if {[is_Windows] || [is_MacOSX]} {
 609        option add *Menu.tearOff 0
 610}
 611
 612if {[is_MacOSX]} {
 613        set M1B M1
 614        set M1T Cmd
 615} else {
 616        set M1B Control
 617        set M1T Ctrl
 618}
 619
 620proc bind_button3 {w cmd} {
 621        bind $w <Any-Button-3> $cmd
 622        if {[is_MacOSX]} {
 623                # Mac OS X sends Button-2 on right click through three-button mouse,
 624                # or through trackpad right-clicking (two-finger touch + click).
 625                bind $w <Any-Button-2> $cmd
 626                bind $w <Control-Button-1> $cmd
 627        }
 628}
 629
 630proc apply_config {} {
 631        global repo_config font_descs
 632
 633        foreach option $font_descs {
 634                set name [lindex $option 0]
 635                set font [lindex $option 1]
 636                if {[catch {
 637                        set need_weight 1
 638                        foreach {cn cv} $repo_config(gui.$name) {
 639                                if {$cn eq {-weight}} {
 640                                        set need_weight 0
 641                                }
 642                                font configure $font $cn $cv
 643                        }
 644                        if {$need_weight} {
 645                                font configure $font -weight normal
 646                        }
 647                        } err]} {
 648                        error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
 649                }
 650                foreach {cn cv} [font configure $font] {
 651                        font configure ${font}bold $cn $cv
 652                        font configure ${font}italic $cn $cv
 653                }
 654                font configure ${font}bold -weight bold
 655                font configure ${font}italic -slant italic
 656        }
 657}
 658
 659set default_config(branch.autosetupmerge) true
 660set default_config(merge.diffstat) true
 661set default_config(merge.summary) false
 662set default_config(merge.verbosity) 2
 663set default_config(user.name) {}
 664set default_config(user.email) {}
 665
 666set default_config(gui.matchtrackingbranch) false
 667set default_config(gui.pruneduringfetch) false
 668set default_config(gui.trustmtime) false
 669set default_config(gui.fastcopyblame) false
 670set default_config(gui.copyblamethreshold) 40
 671set default_config(gui.diffcontext) 5
 672set default_config(gui.commitmsgwidth) 75
 673set default_config(gui.newbranchtemplate) {}
 674set default_config(gui.spellingdictionary) {}
 675set default_config(gui.fontui) [font configure font_ui]
 676set default_config(gui.fontdiff) [font configure font_diff]
 677set font_descs {
 678        {fontui   font_ui   {mc "Main Font"}}
 679        {fontdiff font_diff {mc "Diff/Console Font"}}
 680}
 681
 682######################################################################
 683##
 684## find git
 685
 686set _git  [_which git]
 687if {$_git eq {}} {
 688        catch {wm withdraw .}
 689        tk_messageBox \
 690                -icon error \
 691                -type ok \
 692                -title [mc "git-gui: fatal error"] \
 693                -message [mc "Cannot find git in PATH."]
 694        exit 1
 695}
 696
 697######################################################################
 698##
 699## version check
 700
 701if {[catch {set _git_version [git --version]} err]} {
 702        catch {wm withdraw .}
 703        tk_messageBox \
 704                -icon error \
 705                -type ok \
 706                -title [mc "git-gui: fatal error"] \
 707                -message "Cannot determine Git version:
 708
 709$err
 710
 711[appname] requires Git 1.5.0 or later."
 712        exit 1
 713}
 714if {![regsub {^git version } $_git_version {} _git_version]} {
 715        catch {wm withdraw .}
 716        tk_messageBox \
 717                -icon error \
 718                -type ok \
 719                -title [mc "git-gui: fatal error"] \
 720                -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 721        exit 1
 722}
 723
 724set _real_git_version $_git_version
 725regsub -- {[\-\.]dirty$} $_git_version {} _git_version
 726regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 727regsub {\.rc[0-9]+$} $_git_version {} _git_version
 728regsub {\.GIT$} $_git_version {} _git_version
 729regsub {\.[a-zA-Z]+\.[0-9]+$} $_git_version {} _git_version
 730
 731if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 732        catch {wm withdraw .}
 733        if {[tk_messageBox \
 734                -icon warning \
 735                -type yesno \
 736                -default no \
 737                -title "[appname]: warning" \
 738                 -message [mc "Git version cannot be determined.
 739
 740%s claims it is version '%s'.
 741
 742%s requires at least Git 1.5.0 or later.
 743
 744Assume '%s' is version 1.5.0?
 745" $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 746                set _git_version 1.5.0
 747        } else {
 748                exit 1
 749        }
 750}
 751unset _real_git_version
 752
 753proc git-version {args} {
 754        global _git_version
 755
 756        switch [llength $args] {
 757        0 {
 758                return $_git_version
 759        }
 760
 761        2 {
 762                set op [lindex $args 0]
 763                set vr [lindex $args 1]
 764                set cm [package vcompare $_git_version $vr]
 765                return [expr $cm $op 0]
 766        }
 767
 768        4 {
 769                set type [lindex $args 0]
 770                set name [lindex $args 1]
 771                set parm [lindex $args 2]
 772                set body [lindex $args 3]
 773
 774                if {($type ne {proc} && $type ne {method})} {
 775                        error "Invalid arguments to git-version"
 776                }
 777                if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 778                        error "Last arm of $type $name must be default"
 779                }
 780
 781                foreach {op vr cb} [lrange $body 0 end-2] {
 782                        if {[git-version $op $vr]} {
 783                                return [uplevel [list $type $name $parm $cb]]
 784                        }
 785                }
 786
 787                return [uplevel [list $type $name $parm [lindex $body end]]]
 788        }
 789
 790        default {
 791                error "git-version >= x"
 792        }
 793
 794        }
 795}
 796
 797if {[git-version < 1.5]} {
 798        catch {wm withdraw .}
 799        tk_messageBox \
 800                -icon error \
 801                -type ok \
 802                -title [mc "git-gui: fatal error"] \
 803                -message "[appname] requires Git 1.5.0 or later.
 804
 805You are using [git-version]:
 806
 807[git --version]"
 808        exit 1
 809}
 810
 811######################################################################
 812##
 813## configure our library
 814
 815set idx [file join $oguilib tclIndex]
 816if {[catch {set fd [open $idx r]} err]} {
 817        catch {wm withdraw .}
 818        tk_messageBox \
 819                -icon error \
 820                -type ok \
 821                -title [mc "git-gui: fatal error"] \
 822                -message $err
 823        exit 1
 824}
 825if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
 826        set idx [list]
 827        while {[gets $fd n] >= 0} {
 828                if {$n ne {} && ![string match #* $n]} {
 829                        lappend idx $n
 830                }
 831        }
 832} else {
 833        set idx {}
 834}
 835close $fd
 836
 837if {$idx ne {}} {
 838        set loaded [list]
 839        foreach p $idx {
 840                if {[lsearch -exact $loaded $p] >= 0} continue
 841                source [file join $oguilib $p]
 842                lappend loaded $p
 843        }
 844        unset loaded p
 845} else {
 846        set auto_path [concat [list $oguilib] $auto_path]
 847}
 848unset -nocomplain idx fd
 849
 850######################################################################
 851##
 852## config file parsing
 853
 854git-version proc _parse_config {arr_name args} {
 855        >= 1.5.3 {
 856                upvar $arr_name arr
 857                array unset arr
 858                set buf {}
 859                catch {
 860                        set fd_rc [eval \
 861                                [list git_read config] \
 862                                $args \
 863                                [list --null --list]]
 864                        fconfigure $fd_rc -translation binary
 865                        set buf [read $fd_rc]
 866                        close $fd_rc
 867                }
 868                foreach line [split $buf "\0"] {
 869                        if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
 870                                if {[is_many_config $name]} {
 871                                        lappend arr($name) $value
 872                                } else {
 873                                        set arr($name) $value
 874                                }
 875                        }
 876                }
 877        }
 878        default {
 879                upvar $arr_name arr
 880                array unset arr
 881                catch {
 882                        set fd_rc [eval [list git_read config --list] $args]
 883                        while {[gets $fd_rc line] >= 0} {
 884                                if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 885                                        if {[is_many_config $name]} {
 886                                                lappend arr($name) $value
 887                                        } else {
 888                                                set arr($name) $value
 889                                        }
 890                                }
 891                        }
 892                        close $fd_rc
 893                }
 894        }
 895}
 896
 897proc load_config {include_global} {
 898        global repo_config global_config default_config
 899
 900        if {$include_global} {
 901                _parse_config global_config --global
 902        }
 903        _parse_config repo_config
 904
 905        foreach name [array names default_config] {
 906                if {[catch {set v $global_config($name)}]} {
 907                        set global_config($name) $default_config($name)
 908                }
 909                if {[catch {set v $repo_config($name)}]} {
 910                        set repo_config($name) $default_config($name)
 911                }
 912        }
 913}
 914
 915######################################################################
 916##
 917## feature option selection
 918
 919if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
 920        unset _junk
 921} else {
 922        set subcommand gui
 923}
 924if {$subcommand eq {gui.sh}} {
 925        set subcommand gui
 926}
 927if {$subcommand eq {gui} && [llength $argv] > 0} {
 928        set subcommand [lindex $argv 0]
 929        set argv [lrange $argv 1 end]
 930}
 931
 932enable_option multicommit
 933enable_option branch
 934enable_option transport
 935disable_option bare
 936
 937switch -- $subcommand {
 938browser -
 939blame {
 940        enable_option bare
 941
 942        disable_option multicommit
 943        disable_option branch
 944        disable_option transport
 945}
 946citool {
 947        enable_option singlecommit
 948
 949        disable_option multicommit
 950        disable_option branch
 951        disable_option transport
 952}
 953}
 954
 955######################################################################
 956##
 957## repository setup
 958
 959if {[catch {
 960                set _gitdir $env(GIT_DIR)
 961                set _prefix {}
 962                }]
 963        && [catch {
 964                set _gitdir [git rev-parse --git-dir]
 965                set _prefix [git rev-parse --show-prefix]
 966        } err]} {
 967        load_config 1
 968        apply_config
 969        choose_repository::pick
 970}
 971if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 972        catch {set _gitdir [exec cygpath --windows $_gitdir]}
 973}
 974if {![file isdirectory $_gitdir]} {
 975        catch {wm withdraw .}
 976        error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
 977        exit 1
 978}
 979if {$_prefix ne {}} {
 980        regsub -all {[^/]+/} $_prefix ../ cdup
 981        if {[catch {cd $cdup} err]} {
 982                catch {wm withdraw .}
 983                error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
 984                exit 1
 985        }
 986        unset cdup
 987} elseif {![is_enabled bare]} {
 988        if {[lindex [file split $_gitdir] end] ne {.git}} {
 989                catch {wm withdraw .}
 990                error_popup [strcat [mc "Cannot use funny .git directory:"] "\n\n$_gitdir"]
 991                exit 1
 992        }
 993        if {[catch {cd [file dirname $_gitdir]} err]} {
 994                catch {wm withdraw .}
 995                error_popup [strcat [mc "No working directory"] " [file dirname $_gitdir]:\n\n$err"]
 996                exit 1
 997        }
 998}
 999set _reponame [file split [file normalize $_gitdir]]
1000if {[lindex $_reponame end] eq {.git}} {
1001        set _reponame [lindex $_reponame end-1]
1002} else {
1003        set _reponame [lindex $_reponame end]
1004}
1005
1006######################################################################
1007##
1008## global init
1009
1010set current_diff_path {}
1011set current_diff_side {}
1012set diff_actions [list]
1013
1014set HEAD {}
1015set PARENT {}
1016set MERGE_HEAD [list]
1017set commit_type {}
1018set empty_tree {}
1019set current_branch {}
1020set is_detached 0
1021set current_diff_path {}
1022set is_3way_diff 0
1023set selected_commit_type new
1024
1025######################################################################
1026##
1027## task management
1028
1029set rescan_active 0
1030set diff_active 0
1031set last_clicked {}
1032
1033set disable_on_lock [list]
1034set index_lock_type none
1035
1036proc lock_index {type} {
1037        global index_lock_type disable_on_lock
1038
1039        if {$index_lock_type eq {none}} {
1040                set index_lock_type $type
1041                foreach w $disable_on_lock {
1042                        uplevel #0 $w disabled
1043                }
1044                return 1
1045        } elseif {$index_lock_type eq "begin-$type"} {
1046                set index_lock_type $type
1047                return 1
1048        }
1049        return 0
1050}
1051
1052proc unlock_index {} {
1053        global index_lock_type disable_on_lock
1054
1055        set index_lock_type none
1056        foreach w $disable_on_lock {
1057                uplevel #0 $w normal
1058        }
1059}
1060
1061######################################################################
1062##
1063## status
1064
1065proc repository_state {ctvar hdvar mhvar} {
1066        global current_branch
1067        upvar $ctvar ct $hdvar hd $mhvar mh
1068
1069        set mh [list]
1070
1071        load_current_branch
1072        if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1073                set hd {}
1074                set ct initial
1075                return
1076        }
1077
1078        set merge_head [gitdir MERGE_HEAD]
1079        if {[file exists $merge_head]} {
1080                set ct merge
1081                set fd_mh [open $merge_head r]
1082                while {[gets $fd_mh line] >= 0} {
1083                        lappend mh $line
1084                }
1085                close $fd_mh
1086                return
1087        }
1088
1089        set ct normal
1090}
1091
1092proc PARENT {} {
1093        global PARENT empty_tree
1094
1095        set p [lindex $PARENT 0]
1096        if {$p ne {}} {
1097                return $p
1098        }
1099        if {$empty_tree eq {}} {
1100                set empty_tree [git mktree << {}]
1101        }
1102        return $empty_tree
1103}
1104
1105proc rescan {after {honor_trustmtime 1}} {
1106        global HEAD PARENT MERGE_HEAD commit_type
1107        global ui_index ui_workdir ui_comm
1108        global rescan_active file_states
1109        global repo_config
1110
1111        if {$rescan_active > 0 || ![lock_index read]} return
1112
1113        repository_state newType newHEAD newMERGE_HEAD
1114        if {[string match amend* $commit_type]
1115                && $newType eq {normal}
1116                && $newHEAD eq $HEAD} {
1117        } else {
1118                set HEAD $newHEAD
1119                set PARENT $newHEAD
1120                set MERGE_HEAD $newMERGE_HEAD
1121                set commit_type $newType
1122        }
1123
1124        array unset file_states
1125
1126        if {!$::GITGUI_BCK_exists &&
1127                (![$ui_comm edit modified]
1128                || [string trim [$ui_comm get 0.0 end]] eq {})} {
1129                if {[string match amend* $commit_type]} {
1130                } elseif {[load_message GITGUI_MSG]} {
1131                } elseif {[load_message MERGE_MSG]} {
1132                } elseif {[load_message SQUASH_MSG]} {
1133                }
1134                $ui_comm edit reset
1135                $ui_comm edit modified false
1136        }
1137
1138        if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1139                rescan_stage2 {} $after
1140        } else {
1141                set rescan_active 1
1142                ui_status [mc "Refreshing file status..."]
1143                set fd_rf [git_read update-index \
1144                        -q \
1145                        --unmerged \
1146                        --ignore-missing \
1147                        --refresh \
1148                        ]
1149                fconfigure $fd_rf -blocking 0 -translation binary
1150                fileevent $fd_rf readable \
1151                        [list rescan_stage2 $fd_rf $after]
1152        }
1153}
1154
1155if {[is_Cygwin]} {
1156        set is_git_info_exclude {}
1157        proc have_info_exclude {} {
1158                global is_git_info_exclude
1159
1160                if {$is_git_info_exclude eq {}} {
1161                        if {[catch {exec test -f [gitdir info exclude]}]} {
1162                                set is_git_info_exclude 0
1163                        } else {
1164                                set is_git_info_exclude 1
1165                        }
1166                }
1167                return $is_git_info_exclude
1168        }
1169} else {
1170        proc have_info_exclude {} {
1171                return [file readable [gitdir info exclude]]
1172        }
1173}
1174
1175proc rescan_stage2 {fd after} {
1176        global rescan_active buf_rdi buf_rdf buf_rlo
1177
1178        if {$fd ne {}} {
1179                read $fd
1180                if {![eof $fd]} return
1181                close $fd
1182        }
1183
1184        set ls_others [list --exclude-per-directory=.gitignore]
1185        if {[have_info_exclude]} {
1186                lappend ls_others "--exclude-from=[gitdir info exclude]"
1187        }
1188        set user_exclude [get_config core.excludesfile]
1189        if {$user_exclude ne {} && [file readable $user_exclude]} {
1190                lappend ls_others "--exclude-from=$user_exclude"
1191        }
1192
1193        set buf_rdi {}
1194        set buf_rdf {}
1195        set buf_rlo {}
1196
1197        set rescan_active 3
1198        ui_status [mc "Scanning for modified files ..."]
1199        set fd_di [git_read diff-index --cached -z [PARENT]]
1200        set fd_df [git_read diff-files -z]
1201        set fd_lo [eval git_read ls-files --others -z $ls_others]
1202
1203        fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1204        fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1205        fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1206        fileevent $fd_di readable [list read_diff_index $fd_di $after]
1207        fileevent $fd_df readable [list read_diff_files $fd_df $after]
1208        fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1209}
1210
1211proc load_message {file} {
1212        global ui_comm
1213
1214        set f [gitdir $file]
1215        if {[file isfile $f]} {
1216                if {[catch {set fd [open $f r]}]} {
1217                        return 0
1218                }
1219                fconfigure $fd -eofchar {}
1220                set content [string trim [read $fd]]
1221                close $fd
1222                regsub -all -line {[ \r\t]+$} $content {} content
1223                $ui_comm delete 0.0 end
1224                $ui_comm insert end $content
1225                return 1
1226        }
1227        return 0
1228}
1229
1230proc read_diff_index {fd after} {
1231        global buf_rdi
1232
1233        append buf_rdi [read $fd]
1234        set c 0
1235        set n [string length $buf_rdi]
1236        while {$c < $n} {
1237                set z1 [string first "\0" $buf_rdi $c]
1238                if {$z1 == -1} break
1239                incr z1
1240                set z2 [string first "\0" $buf_rdi $z1]
1241                if {$z2 == -1} break
1242
1243                incr c
1244                set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1245                set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1246                merge_state \
1247                        [encoding convertfrom $p] \
1248                        [lindex $i 4]? \
1249                        [list [lindex $i 0] [lindex $i 2]] \
1250                        [list]
1251                set c $z2
1252                incr c
1253        }
1254        if {$c < $n} {
1255                set buf_rdi [string range $buf_rdi $c end]
1256        } else {
1257                set buf_rdi {}
1258        }
1259
1260        rescan_done $fd buf_rdi $after
1261}
1262
1263proc read_diff_files {fd after} {
1264        global buf_rdf
1265
1266        append buf_rdf [read $fd]
1267        set c 0
1268        set n [string length $buf_rdf]
1269        while {$c < $n} {
1270                set z1 [string first "\0" $buf_rdf $c]
1271                if {$z1 == -1} break
1272                incr z1
1273                set z2 [string first "\0" $buf_rdf $z1]
1274                if {$z2 == -1} break
1275
1276                incr c
1277                set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1278                set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1279                merge_state \
1280                        [encoding convertfrom $p] \
1281                        ?[lindex $i 4] \
1282                        [list] \
1283                        [list [lindex $i 0] [lindex $i 2]]
1284                set c $z2
1285                incr c
1286        }
1287        if {$c < $n} {
1288                set buf_rdf [string range $buf_rdf $c end]
1289        } else {
1290                set buf_rdf {}
1291        }
1292
1293        rescan_done $fd buf_rdf $after
1294}
1295
1296proc read_ls_others {fd after} {
1297        global buf_rlo
1298
1299        append buf_rlo [read $fd]
1300        set pck [split $buf_rlo "\0"]
1301        set buf_rlo [lindex $pck end]
1302        foreach p [lrange $pck 0 end-1] {
1303                set p [encoding convertfrom $p]
1304                if {[string index $p end] eq {/}} {
1305                        set p [string range $p 0 end-1]
1306                }
1307                merge_state $p ?O
1308        }
1309        rescan_done $fd buf_rlo $after
1310}
1311
1312proc rescan_done {fd buf after} {
1313        global rescan_active current_diff_path
1314        global file_states repo_config
1315        upvar $buf to_clear
1316
1317        if {![eof $fd]} return
1318        set to_clear {}
1319        close $fd
1320        if {[incr rescan_active -1] > 0} return
1321
1322        prune_selection
1323        unlock_index
1324        display_all_files
1325        if {$current_diff_path ne {}} reshow_diff
1326        uplevel #0 $after
1327}
1328
1329proc prune_selection {} {
1330        global file_states selected_paths
1331
1332        foreach path [array names selected_paths] {
1333                if {[catch {set still_here $file_states($path)}]} {
1334                        unset selected_paths($path)
1335                }
1336        }
1337}
1338
1339######################################################################
1340##
1341## ui helpers
1342
1343proc mapicon {w state path} {
1344        global all_icons
1345
1346        if {[catch {set r $all_icons($state$w)}]} {
1347                puts "error: no icon for $w state={$state} $path"
1348                return file_plain
1349        }
1350        return $r
1351}
1352
1353proc mapdesc {state path} {
1354        global all_descs
1355
1356        if {[catch {set r $all_descs($state)}]} {
1357                puts "error: no desc for state={$state} $path"
1358                return $state
1359        }
1360        return $r
1361}
1362
1363proc ui_status {msg} {
1364        global main_status
1365        if {[info exists main_status]} {
1366                $main_status show $msg
1367        }
1368}
1369
1370proc ui_ready {{test {}}} {
1371        global main_status
1372        if {[info exists main_status]} {
1373                $main_status show [mc "Ready."] $test
1374        }
1375}
1376
1377proc escape_path {path} {
1378        regsub -all {\\} $path "\\\\" path
1379        regsub -all "\n" $path "\\n" path
1380        return $path
1381}
1382
1383proc short_path {path} {
1384        return [escape_path [lindex [file split $path] end]]
1385}
1386
1387set next_icon_id 0
1388set null_sha1 [string repeat 0 40]
1389
1390proc merge_state {path new_state {head_info {}} {index_info {}}} {
1391        global file_states next_icon_id null_sha1
1392
1393        set s0 [string index $new_state 0]
1394        set s1 [string index $new_state 1]
1395
1396        if {[catch {set info $file_states($path)}]} {
1397                set state __
1398                set icon n[incr next_icon_id]
1399        } else {
1400                set state [lindex $info 0]
1401                set icon [lindex $info 1]
1402                if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1403                if {$index_info eq {}} {set index_info [lindex $info 3]}
1404        }
1405
1406        if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1407        elseif {$s0 eq {_}} {set s0 _}
1408
1409        if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1410        elseif {$s1 eq {_}} {set s1 _}
1411
1412        if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1413                set head_info [list 0 $null_sha1]
1414        } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1415                && $head_info eq {}} {
1416                set head_info $index_info
1417        }
1418
1419        set file_states($path) [list $s0$s1 $icon \
1420                $head_info $index_info \
1421                ]
1422        return $state
1423}
1424
1425proc display_file_helper {w path icon_name old_m new_m} {
1426        global file_lists
1427
1428        if {$new_m eq {_}} {
1429                set lno [lsearch -sorted -exact $file_lists($w) $path]
1430                if {$lno >= 0} {
1431                        set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1432                        incr lno
1433                        $w conf -state normal
1434                        $w delete $lno.0 [expr {$lno + 1}].0
1435                        $w conf -state disabled
1436                }
1437        } elseif {$old_m eq {_} && $new_m ne {_}} {
1438                lappend file_lists($w) $path
1439                set file_lists($w) [lsort -unique $file_lists($w)]
1440                set lno [lsearch -sorted -exact $file_lists($w) $path]
1441                incr lno
1442                $w conf -state normal
1443                $w image create $lno.0 \
1444                        -align center -padx 5 -pady 1 \
1445                        -name $icon_name \
1446                        -image [mapicon $w $new_m $path]
1447                $w insert $lno.1 "[escape_path $path]\n"
1448                $w conf -state disabled
1449        } elseif {$old_m ne $new_m} {
1450                $w conf -state normal
1451                $w image conf $icon_name -image [mapicon $w $new_m $path]
1452                $w conf -state disabled
1453        }
1454}
1455
1456proc display_file {path state} {
1457        global file_states selected_paths
1458        global ui_index ui_workdir
1459
1460        set old_m [merge_state $path $state]
1461        set s $file_states($path)
1462        set new_m [lindex $s 0]
1463        set icon_name [lindex $s 1]
1464
1465        set o [string index $old_m 0]
1466        set n [string index $new_m 0]
1467        if {$o eq {U}} {
1468                set o _
1469        }
1470        if {$n eq {U}} {
1471                set n _
1472        }
1473        display_file_helper     $ui_index $path $icon_name $o $n
1474
1475        if {[string index $old_m 0] eq {U}} {
1476                set o U
1477        } else {
1478                set o [string index $old_m 1]
1479        }
1480        if {[string index $new_m 0] eq {U}} {
1481                set n U
1482        } else {
1483                set n [string index $new_m 1]
1484        }
1485        display_file_helper     $ui_workdir $path $icon_name $o $n
1486
1487        if {$new_m eq {__}} {
1488                unset file_states($path)
1489                catch {unset selected_paths($path)}
1490        }
1491}
1492
1493proc display_all_files_helper {w path icon_name m} {
1494        global file_lists
1495
1496        lappend file_lists($w) $path
1497        set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1498        $w image create end \
1499                -align center -padx 5 -pady 1 \
1500                -name $icon_name \
1501                -image [mapicon $w $m $path]
1502        $w insert end "[escape_path $path]\n"
1503}
1504
1505proc display_all_files {} {
1506        global ui_index ui_workdir
1507        global file_states file_lists
1508        global last_clicked
1509
1510        $ui_index conf -state normal
1511        $ui_workdir conf -state normal
1512
1513        $ui_index delete 0.0 end
1514        $ui_workdir delete 0.0 end
1515        set last_clicked {}
1516
1517        set file_lists($ui_index) [list]
1518        set file_lists($ui_workdir) [list]
1519
1520        foreach path [lsort [array names file_states]] {
1521                set s $file_states($path)
1522                set m [lindex $s 0]
1523                set icon_name [lindex $s 1]
1524
1525                set s [string index $m 0]
1526                if {$s ne {U} && $s ne {_}} {
1527                        display_all_files_helper $ui_index $path \
1528                                $icon_name $s
1529                }
1530
1531                if {[string index $m 0] eq {U}} {
1532                        set s U
1533                } else {
1534                        set s [string index $m 1]
1535                }
1536                if {$s ne {_}} {
1537                        display_all_files_helper $ui_workdir $path \
1538                                $icon_name $s
1539                }
1540        }
1541
1542        $ui_index conf -state disabled
1543        $ui_workdir conf -state disabled
1544}
1545
1546######################################################################
1547##
1548## icons
1549
1550set filemask {
1551#define mask_width 14
1552#define mask_height 15
1553static unsigned char mask_bits[] = {
1554   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1555   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1556   0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1557}
1558
1559image create bitmap file_plain -background white -foreground black -data {
1560#define plain_width 14
1561#define plain_height 15
1562static unsigned char plain_bits[] = {
1563   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1564   0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1565   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1566} -maskdata $filemask
1567
1568image create bitmap file_mod -background white -foreground blue -data {
1569#define mod_width 14
1570#define mod_height 15
1571static unsigned char mod_bits[] = {
1572   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1573   0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1574   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1575} -maskdata $filemask
1576
1577image create bitmap file_fulltick -background white -foreground "#007000" -data {
1578#define file_fulltick_width 14
1579#define file_fulltick_height 15
1580static unsigned char file_fulltick_bits[] = {
1581   0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1582   0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1583   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1584} -maskdata $filemask
1585
1586image create bitmap file_parttick -background white -foreground "#005050" -data {
1587#define parttick_width 14
1588#define parttick_height 15
1589static unsigned char parttick_bits[] = {
1590   0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1591   0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1592   0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1593} -maskdata $filemask
1594
1595image create bitmap file_question -background white -foreground black -data {
1596#define file_question_width 14
1597#define file_question_height 15
1598static unsigned char file_question_bits[] = {
1599   0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1600   0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1601   0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1602} -maskdata $filemask
1603
1604image create bitmap file_removed -background white -foreground red -data {
1605#define file_removed_width 14
1606#define file_removed_height 15
1607static unsigned char file_removed_bits[] = {
1608   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1609   0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1610   0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1611} -maskdata $filemask
1612
1613image create bitmap file_merge -background white -foreground blue -data {
1614#define file_merge_width 14
1615#define file_merge_height 15
1616static unsigned char file_merge_bits[] = {
1617   0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1618   0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1619   0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1620} -maskdata $filemask
1621
1622image create bitmap file_statechange -background white -foreground green -data {
1623#define file_merge_width 14
1624#define file_merge_height 15
1625static unsigned char file_statechange_bits[] = {
1626   0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1627   0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1628   0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1629} -maskdata $filemask
1630
1631set ui_index .vpane.files.index.list
1632set ui_workdir .vpane.files.workdir.list
1633
1634set all_icons(_$ui_index)   file_plain
1635set all_icons(A$ui_index)   file_fulltick
1636set all_icons(M$ui_index)   file_fulltick
1637set all_icons(D$ui_index)   file_removed
1638set all_icons(U$ui_index)   file_merge
1639set all_icons(T$ui_index)   file_statechange
1640
1641set all_icons(_$ui_workdir) file_plain
1642set all_icons(M$ui_workdir) file_mod
1643set all_icons(D$ui_workdir) file_question
1644set all_icons(U$ui_workdir) file_merge
1645set all_icons(O$ui_workdir) file_plain
1646set all_icons(T$ui_workdir) file_statechange
1647
1648set max_status_desc 0
1649foreach i {
1650                {__ {mc "Unmodified"}}
1651
1652                {_M {mc "Modified, not staged"}}
1653                {M_ {mc "Staged for commit"}}
1654                {MM {mc "Portions staged for commit"}}
1655                {MD {mc "Staged for commit, missing"}}
1656
1657                {_T {mc "File type changed, not staged"}}
1658                {T_ {mc "File type changed, staged"}}
1659
1660                {_O {mc "Untracked, not staged"}}
1661                {A_ {mc "Staged for commit"}}
1662                {AM {mc "Portions staged for commit"}}
1663                {AD {mc "Staged for commit, missing"}}
1664
1665                {_D {mc "Missing"}}
1666                {D_ {mc "Staged for removal"}}
1667                {DO {mc "Staged for removal, still present"}}
1668
1669                {U_ {mc "Requires merge resolution"}}
1670                {UU {mc "Requires merge resolution"}}
1671                {UM {mc "Requires merge resolution"}}
1672                {UD {mc "Requires merge resolution"}}
1673        } {
1674        set text [eval [lindex $i 1]]
1675        if {$max_status_desc < [string length $text]} {
1676                set max_status_desc [string length $text]
1677        }
1678        set all_descs([lindex $i 0]) $text
1679}
1680unset i
1681
1682######################################################################
1683##
1684## util
1685
1686proc scrollbar2many {list mode args} {
1687        foreach w $list {eval $w $mode $args}
1688}
1689
1690proc many2scrollbar {list mode sb top bottom} {
1691        $sb set $top $bottom
1692        foreach w $list {$w $mode moveto $top}
1693}
1694
1695proc incr_font_size {font {amt 1}} {
1696        set sz [font configure $font -size]
1697        incr sz $amt
1698        font configure $font -size $sz
1699        font configure ${font}bold -size $sz
1700        font configure ${font}italic -size $sz
1701}
1702
1703######################################################################
1704##
1705## ui commands
1706
1707set starting_gitk_msg [mc "Starting gitk... please wait..."]
1708
1709proc do_gitk {revs} {
1710        # -- Always start gitk through whatever we were loaded with.  This
1711        #    lets us bypass using shell process on Windows systems.
1712        #
1713        set exe [_which gitk -script]
1714        set cmd [list [info nameofexecutable] $exe]
1715        if {$exe eq {}} {
1716                error_popup [mc "Couldn't find gitk in PATH"]
1717        } else {
1718                global env
1719
1720                if {[info exists env(GIT_DIR)]} {
1721                        set old_GIT_DIR $env(GIT_DIR)
1722                } else {
1723                        set old_GIT_DIR {}
1724                }
1725
1726                set pwd [pwd]
1727                cd [file dirname [gitdir]]
1728                set env(GIT_DIR) [file tail [gitdir]]
1729
1730                eval exec $cmd $revs &
1731
1732                if {$old_GIT_DIR eq {}} {
1733                        unset env(GIT_DIR)
1734                } else {
1735                        set env(GIT_DIR) $old_GIT_DIR
1736                }
1737                cd $pwd
1738
1739                ui_status $::starting_gitk_msg
1740                after 10000 {
1741                        ui_ready $starting_gitk_msg
1742                }
1743        }
1744}
1745
1746set is_quitting 0
1747
1748proc do_quit {} {
1749        global ui_comm is_quitting repo_config commit_type
1750        global GITGUI_BCK_exists GITGUI_BCK_i
1751        global ui_comm_spell
1752
1753        if {$is_quitting} return
1754        set is_quitting 1
1755
1756        if {[winfo exists $ui_comm]} {
1757                # -- Stash our current commit buffer.
1758                #
1759                set save [gitdir GITGUI_MSG]
1760                if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
1761                        file rename -force [gitdir GITGUI_BCK] $save
1762                        set GITGUI_BCK_exists 0
1763                } else {
1764                        set msg [string trim [$ui_comm get 0.0 end]]
1765                        regsub -all -line {[ \r\t]+$} $msg {} msg
1766                        if {(![string match amend* $commit_type]
1767                                || [$ui_comm edit modified])
1768                                && $msg ne {}} {
1769                                catch {
1770                                        set fd [open $save w]
1771                                        puts -nonewline $fd $msg
1772                                        close $fd
1773                                }
1774                        } else {
1775                                catch {file delete $save}
1776                        }
1777                }
1778
1779                # -- Cancel our spellchecker if its running.
1780                #
1781                if {[info exists ui_comm_spell]} {
1782                        $ui_comm_spell stop
1783                }
1784
1785                # -- Remove our editor backup, its not needed.
1786                #
1787                after cancel $GITGUI_BCK_i
1788                if {$GITGUI_BCK_exists} {
1789                        catch {file delete [gitdir GITGUI_BCK]}
1790                }
1791
1792                # -- Stash our current window geometry into this repository.
1793                #
1794                set cfg_geometry [list]
1795                lappend cfg_geometry [wm geometry .]
1796                lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
1797                lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
1798                if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1799                        set rc_geometry {}
1800                }
1801                if {$cfg_geometry ne $rc_geometry} {
1802                        catch {git config gui.geometry $cfg_geometry}
1803                }
1804        }
1805
1806        destroy .
1807}
1808
1809proc do_rescan {} {
1810        rescan ui_ready
1811}
1812
1813proc do_commit {} {
1814        commit_tree
1815}
1816
1817proc next_diff {} {
1818        global next_diff_p next_diff_w next_diff_i
1819        show_diff $next_diff_p $next_diff_w $next_diff_i
1820}
1821
1822proc toggle_or_diff {w x y} {
1823        global file_states file_lists current_diff_path ui_index ui_workdir
1824        global last_clicked selected_paths
1825
1826        set pos [split [$w index @$x,$y] .]
1827        set lno [lindex $pos 0]
1828        set col [lindex $pos 1]
1829        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1830        if {$path eq {}} {
1831                set last_clicked {}
1832                return
1833        }
1834
1835        set last_clicked [list $w $lno]
1836        array unset selected_paths
1837        $ui_index tag remove in_sel 0.0 end
1838        $ui_workdir tag remove in_sel 0.0 end
1839
1840        if {$col == 0 && $y > 1} {
1841                set i [expr {$lno-1}]
1842                set ll [expr {[llength $file_lists($w)]-1}]
1843
1844                if {$i == $ll && $i == 0} {
1845                        set after {reshow_diff;}
1846                } else {
1847                        global next_diff_p next_diff_w next_diff_i
1848
1849                        set next_diff_w $w
1850
1851                        if {$i < $ll} {
1852                                set i [expr {$i + 1}]
1853                                set next_diff_i $i
1854                        } else {
1855                                set next_diff_i $i
1856                                set i [expr {$i - 1}]
1857                        }
1858
1859                        set next_diff_p [lindex $file_lists($w) $i]
1860
1861                        if {$next_diff_p ne {} && $current_diff_path ne {}} {
1862                                set after {next_diff;}
1863                        } else {
1864                                set after {}
1865                        }
1866                }
1867
1868                if {$w eq $ui_index} {
1869                        update_indexinfo \
1870                                "Unstaging [short_path $path] from commit" \
1871                                [list $path] \
1872                                [concat $after [list ui_ready]]
1873                } elseif {$w eq $ui_workdir} {
1874                        update_index \
1875                                "Adding [short_path $path]" \
1876                                [list $path] \
1877                                [concat $after [list ui_ready]]
1878                }
1879        } else {
1880                show_diff $path $w $lno
1881        }
1882}
1883
1884proc add_one_to_selection {w x y} {
1885        global file_lists last_clicked selected_paths
1886
1887        set lno [lindex [split [$w index @$x,$y] .] 0]
1888        set path [lindex $file_lists($w) [expr {$lno - 1}]]
1889        if {$path eq {}} {
1890                set last_clicked {}
1891                return
1892        }
1893
1894        if {$last_clicked ne {}
1895                && [lindex $last_clicked 0] ne $w} {
1896                array unset selected_paths
1897                [lindex $last_clicked 0] tag remove in_sel 0.0 end
1898        }
1899
1900        set last_clicked [list $w $lno]
1901        if {[catch {set in_sel $selected_paths($path)}]} {
1902                set in_sel 0
1903        }
1904        if {$in_sel} {
1905                unset selected_paths($path)
1906                $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
1907        } else {
1908                set selected_paths($path) 1
1909                $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1910        }
1911}
1912
1913proc add_range_to_selection {w x y} {
1914        global file_lists last_clicked selected_paths
1915
1916        if {[lindex $last_clicked 0] ne $w} {
1917                toggle_or_diff $w $x $y
1918                return
1919        }
1920
1921        set lno [lindex [split [$w index @$x,$y] .] 0]
1922        set lc [lindex $last_clicked 1]
1923        if {$lc < $lno} {
1924                set begin $lc
1925                set end $lno
1926        } else {
1927                set begin $lno
1928                set end $lc
1929        }
1930
1931        foreach path [lrange $file_lists($w) \
1932                [expr {$begin - 1}] \
1933                [expr {$end - 1}]] {
1934                set selected_paths($path) 1
1935        }
1936        $w tag add in_sel $begin.0 [expr {$end + 1}].0
1937}
1938
1939proc show_more_context {} {
1940        global repo_config
1941        if {$repo_config(gui.diffcontext) < 99} {
1942                incr repo_config(gui.diffcontext)
1943                reshow_diff
1944        }
1945}
1946
1947proc show_less_context {} {
1948        global repo_config
1949        if {$repo_config(gui.diffcontext) >= 1} {
1950                incr repo_config(gui.diffcontext) -1
1951                reshow_diff
1952        }
1953}
1954
1955######################################################################
1956##
1957## ui construction
1958
1959load_config 0
1960apply_config
1961set ui_comm {}
1962
1963# -- Menu Bar
1964#
1965menu .mbar -tearoff 0
1966.mbar add cascade -label [mc Repository] -menu .mbar.repository
1967.mbar add cascade -label [mc Edit] -menu .mbar.edit
1968if {[is_enabled branch]} {
1969        .mbar add cascade -label [mc Branch] -menu .mbar.branch
1970}
1971if {[is_enabled multicommit] || [is_enabled singlecommit]} {
1972        .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
1973}
1974if {[is_enabled transport]} {
1975        .mbar add cascade -label [mc Merge] -menu .mbar.merge
1976        .mbar add cascade -label [mc Remote] -menu .mbar.remote
1977}
1978. configure -menu .mbar
1979
1980# -- Repository Menu
1981#
1982menu .mbar.repository
1983
1984.mbar.repository add command \
1985        -label [mc "Browse Current Branch's Files"] \
1986        -command {browser::new $current_branch}
1987set ui_browse_current [.mbar.repository index last]
1988.mbar.repository add command \
1989        -label [mc "Browse Branch Files..."] \
1990        -command browser_open::dialog
1991.mbar.repository add separator
1992
1993.mbar.repository add command \
1994        -label [mc "Visualize Current Branch's History"] \
1995        -command {do_gitk $current_branch}
1996set ui_visualize_current [.mbar.repository index last]
1997.mbar.repository add command \
1998        -label [mc "Visualize All Branch History"] \
1999        -command {do_gitk --all}
2000.mbar.repository add separator
2001
2002proc current_branch_write {args} {
2003        global current_branch
2004        .mbar.repository entryconf $::ui_browse_current \
2005                -label [mc "Browse %s's Files" $current_branch]
2006        .mbar.repository entryconf $::ui_visualize_current \
2007                -label [mc "Visualize %s's History" $current_branch]
2008}
2009trace add variable current_branch write current_branch_write
2010
2011if {[is_enabled multicommit]} {
2012        .mbar.repository add command -label [mc "Database Statistics"] \
2013                -command do_stats
2014
2015        .mbar.repository add command -label [mc "Compress Database"] \
2016                -command do_gc
2017
2018        .mbar.repository add command -label [mc "Verify Database"] \
2019                -command do_fsck_objects
2020
2021        .mbar.repository add separator
2022
2023        if {[is_Cygwin]} {
2024                .mbar.repository add command \
2025                        -label [mc "Create Desktop Icon"] \
2026                        -command do_cygwin_shortcut
2027        } elseif {[is_Windows]} {
2028                .mbar.repository add command \
2029                        -label [mc "Create Desktop Icon"] \
2030                        -command do_windows_shortcut
2031        } elseif {[is_MacOSX]} {
2032                .mbar.repository add command \
2033                        -label [mc "Create Desktop Icon"] \
2034                        -command do_macosx_app
2035        }
2036}
2037
2038if {[is_MacOSX]} {
2039        proc ::tk::mac::Quit {args} { do_quit }
2040} else {
2041        .mbar.repository add command -label [mc Quit] \
2042                -command do_quit \
2043                -accelerator $M1T-Q
2044}
2045
2046# -- Edit Menu
2047#
2048menu .mbar.edit
2049.mbar.edit add command -label [mc Undo] \
2050        -command {catch {[focus] edit undo}} \
2051        -accelerator $M1T-Z
2052.mbar.edit add command -label [mc Redo] \
2053        -command {catch {[focus] edit redo}} \
2054        -accelerator $M1T-Y
2055.mbar.edit add separator
2056.mbar.edit add command -label [mc Cut] \
2057        -command {catch {tk_textCut [focus]}} \
2058        -accelerator $M1T-X
2059.mbar.edit add command -label [mc Copy] \
2060        -command {catch {tk_textCopy [focus]}} \
2061        -accelerator $M1T-C
2062.mbar.edit add command -label [mc Paste] \
2063        -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2064        -accelerator $M1T-V
2065.mbar.edit add command -label [mc Delete] \
2066        -command {catch {[focus] delete sel.first sel.last}} \
2067        -accelerator Del
2068.mbar.edit add separator
2069.mbar.edit add command -label [mc "Select All"] \
2070        -command {catch {[focus] tag add sel 0.0 end}} \
2071        -accelerator $M1T-A
2072
2073# -- Branch Menu
2074#
2075if {[is_enabled branch]} {
2076        menu .mbar.branch
2077
2078        .mbar.branch add command -label [mc "Create..."] \
2079                -command branch_create::dialog \
2080                -accelerator $M1T-N
2081        lappend disable_on_lock [list .mbar.branch entryconf \
2082                [.mbar.branch index last] -state]
2083
2084        .mbar.branch add command -label [mc "Checkout..."] \
2085                -command branch_checkout::dialog \
2086                -accelerator $M1T-O
2087        lappend disable_on_lock [list .mbar.branch entryconf \
2088                [.mbar.branch index last] -state]
2089
2090        .mbar.branch add command -label [mc "Rename..."] \
2091                -command branch_rename::dialog
2092        lappend disable_on_lock [list .mbar.branch entryconf \
2093                [.mbar.branch index last] -state]
2094
2095        .mbar.branch add command -label [mc "Delete..."] \
2096                -command branch_delete::dialog
2097        lappend disable_on_lock [list .mbar.branch entryconf \
2098                [.mbar.branch index last] -state]
2099
2100        .mbar.branch add command -label [mc "Reset..."] \
2101                -command merge::reset_hard
2102        lappend disable_on_lock [list .mbar.branch entryconf \
2103                [.mbar.branch index last] -state]
2104}
2105
2106# -- Commit Menu
2107#
2108if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2109        menu .mbar.commit
2110
2111        .mbar.commit add radiobutton \
2112                -label [mc "New Commit"] \
2113                -command do_select_commit_type \
2114                -variable selected_commit_type \
2115                -value new
2116        lappend disable_on_lock \
2117                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2118
2119        .mbar.commit add radiobutton \
2120                -label [mc "Amend Last Commit"] \
2121                -command do_select_commit_type \
2122                -variable selected_commit_type \
2123                -value amend
2124        lappend disable_on_lock \
2125                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2126
2127        .mbar.commit add separator
2128
2129        .mbar.commit add command -label [mc Rescan] \
2130                -command do_rescan \
2131                -accelerator F5
2132        lappend disable_on_lock \
2133                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2134
2135        .mbar.commit add command -label [mc "Stage To Commit"] \
2136                -command do_add_selection \
2137                -accelerator $M1T-T
2138        lappend disable_on_lock \
2139                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2140
2141        .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2142                -command do_add_all \
2143                -accelerator $M1T-I
2144        lappend disable_on_lock \
2145                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2146
2147        .mbar.commit add command -label [mc "Unstage From Commit"] \
2148                -command do_unstage_selection
2149        lappend disable_on_lock \
2150                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2151
2152        .mbar.commit add command -label [mc "Revert Changes"] \
2153                -command do_revert_selection
2154        lappend disable_on_lock \
2155                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2156
2157        .mbar.commit add separator
2158
2159        .mbar.commit add command -label [mc "Show Less Context"] \
2160                -command show_less_context \
2161                -accelerator $M1T-\-
2162
2163        .mbar.commit add command -label [mc "Show More Context"] \
2164                -command show_more_context \
2165                -accelerator $M1T-=
2166
2167        .mbar.commit add separator
2168
2169        .mbar.commit add command -label [mc "Sign Off"] \
2170                -command do_signoff \
2171                -accelerator $M1T-S
2172
2173        .mbar.commit add command -label [mc Commit@@verb] \
2174                -command do_commit \
2175                -accelerator $M1T-Return
2176        lappend disable_on_lock \
2177                [list .mbar.commit entryconf [.mbar.commit index last] -state]
2178}
2179
2180# -- Merge Menu
2181#
2182if {[is_enabled branch]} {
2183        menu .mbar.merge
2184        .mbar.merge add command -label [mc "Local Merge..."] \
2185                -command merge::dialog \
2186                -accelerator $M1T-M
2187        lappend disable_on_lock \
2188                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2189        .mbar.merge add command -label [mc "Abort Merge..."] \
2190                -command merge::reset_hard
2191        lappend disable_on_lock \
2192                [list .mbar.merge entryconf [.mbar.merge index last] -state]
2193}
2194
2195# -- Transport Menu
2196#
2197if {[is_enabled transport]} {
2198        menu .mbar.remote
2199
2200        .mbar.remote add command \
2201                -label [mc "Push..."] \
2202                -command do_push_anywhere \
2203                -accelerator $M1T-P
2204        .mbar.remote add command \
2205                -label [mc "Delete..."] \
2206                -command remote_branch_delete::dialog
2207}
2208
2209if {[is_MacOSX]} {
2210        # -- Apple Menu (Mac OS X only)
2211        #
2212        .mbar add cascade -label Apple -menu .mbar.apple
2213        menu .mbar.apple
2214
2215        .mbar.apple add command -label [mc "About %s" [appname]] \
2216                -command do_about
2217        .mbar.apple add separator
2218        .mbar.apple add command \
2219                -label [mc "Preferences..."] \
2220                -command do_options \
2221                -accelerator $M1T-,
2222        bind . <$M1B-,> do_options
2223} else {
2224        # -- Edit Menu
2225        #
2226        .mbar.edit add separator
2227        .mbar.edit add command -label [mc "Options..."] \
2228                -command do_options
2229}
2230
2231# -- Help Menu
2232#
2233.mbar add cascade -label [mc Help] -menu .mbar.help
2234menu .mbar.help
2235
2236if {![is_MacOSX]} {
2237        .mbar.help add command -label [mc "About %s" [appname]] \
2238                -command do_about
2239}
2240
2241set browser {}
2242catch {set browser $repo_config(instaweb.browser)}
2243set doc_path [file dirname [gitexec]]
2244set doc_path [file join $doc_path Documentation index.html]
2245
2246if {[is_Cygwin]} {
2247        set doc_path [exec cygpath --mixed $doc_path]
2248}
2249
2250if {$browser eq {}} {
2251        if {[is_MacOSX]} {
2252                set browser open
2253        } elseif {[is_Cygwin]} {
2254                set program_files [file dirname [exec cygpath --windir]]
2255                set program_files [file join $program_files {Program Files}]
2256                set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
2257                set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
2258                if {[file exists $firefox]} {
2259                        set browser $firefox
2260                } elseif {[file exists $ie]} {
2261                        set browser $ie
2262                }
2263                unset program_files firefox ie
2264        }
2265}
2266
2267if {[file isfile $doc_path]} {
2268        set doc_url "file:$doc_path"
2269} else {
2270        set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2271}
2272
2273if {$browser ne {}} {
2274        .mbar.help add command -label [mc "Online Documentation"] \
2275                -command [list exec $browser $doc_url &]
2276}
2277unset browser doc_path doc_url
2278
2279# -- Standard bindings
2280#
2281wm protocol . WM_DELETE_WINDOW do_quit
2282bind all <$M1B-Key-q> do_quit
2283bind all <$M1B-Key-Q> do_quit
2284bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2285bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2286
2287set subcommand_args {}
2288proc usage {} {
2289        puts stderr "usage: $::argv0 $::subcommand $::subcommand_args"
2290        exit 1
2291}
2292
2293# -- Not a normal commit type invocation?  Do that instead!
2294#
2295switch -- $subcommand {
2296browser -
2297blame {
2298        set subcommand_args {rev? path}
2299        if {$argv eq {}} usage
2300        set head {}
2301        set path {}
2302        set is_path 0
2303        foreach a $argv {
2304                if {$is_path || [file exists $_prefix$a]} {
2305                        if {$path ne {}} usage
2306                        set path $_prefix$a
2307                        break
2308                } elseif {$a eq {--}} {
2309                        if {$path ne {}} {
2310                                if {$head ne {}} usage
2311                                set head $path
2312                                set path {}
2313                        }
2314                        set is_path 1
2315                } elseif {$head eq {}} {
2316                        if {$head ne {}} usage
2317                        set head $a
2318                        set is_path 1
2319                } else {
2320                        usage
2321                }
2322        }
2323        unset is_path
2324
2325        if {$head ne {} && $path eq {}} {
2326                set path $_prefix$head
2327                set head {}
2328        }
2329
2330        if {$head eq {}} {
2331                load_current_branch
2332        } else {
2333                if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2334                        if {[catch {
2335                                        set head [git rev-parse --verify $head]
2336                                } err]} {
2337                                puts stderr $err
2338                                exit 1
2339                        }
2340                }
2341                set current_branch $head
2342        }
2343
2344        switch -- $subcommand {
2345        browser {
2346                if {$head eq {}} {
2347                        if {$path ne {} && [file isdirectory $path]} {
2348                                set head $current_branch
2349                        } else {
2350                                set head $path
2351                                set path {}
2352                        }
2353                }
2354                browser::new $head $path
2355        }
2356        blame   {
2357                if {$head eq {} && ![file exists $path]} {
2358                        puts stderr [mc "fatal: cannot stat path %s: No such file or directory" $path]
2359                        exit 1
2360                }
2361                blame::new $head $path
2362        }
2363        }
2364        return
2365}
2366citool -
2367gui {
2368        if {[llength $argv] != 0} {
2369                puts -nonewline stderr "usage: $argv0"
2370                if {$subcommand ne {gui}
2371                        && [file tail $argv0] ne "git-$subcommand"} {
2372                        puts -nonewline stderr " $subcommand"
2373                }
2374                puts stderr {}
2375                exit 1
2376        }
2377        # fall through to setup UI for commits
2378}
2379default {
2380        puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2381        exit 1
2382}
2383}
2384
2385# -- Branch Control
2386#
2387frame .branch \
2388        -borderwidth 1 \
2389        -relief sunken
2390label .branch.l1 \
2391        -text [mc "Current Branch:"] \
2392        -anchor w \
2393        -justify left
2394label .branch.cb \
2395        -textvariable current_branch \
2396        -anchor w \
2397        -justify left
2398pack .branch.l1 -side left
2399pack .branch.cb -side left -fill x
2400pack .branch -side top -fill x
2401
2402# -- Main Window Layout
2403#
2404panedwindow .vpane -orient horizontal
2405panedwindow .vpane.files -orient vertical
2406.vpane add .vpane.files -sticky nsew -height 100 -width 200
2407pack .vpane -anchor n -side top -fill both -expand 1
2408
2409# -- Index File List
2410#
2411frame .vpane.files.index -height 100 -width 200
2412label .vpane.files.index.title -text [mc "Staged Changes (Will Commit)"] \
2413        -background lightgreen -foreground black
2414text $ui_index -background white -foreground black \
2415        -borderwidth 0 \
2416        -width 20 -height 10 \
2417        -wrap none \
2418        -cursor $cursor_ptr \
2419        -xscrollcommand {.vpane.files.index.sx set} \
2420        -yscrollcommand {.vpane.files.index.sy set} \
2421        -state disabled
2422scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
2423scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
2424pack .vpane.files.index.title -side top -fill x
2425pack .vpane.files.index.sx -side bottom -fill x
2426pack .vpane.files.index.sy -side right -fill y
2427pack $ui_index -side left -fill both -expand 1
2428
2429# -- Working Directory File List
2430#
2431frame .vpane.files.workdir -height 100 -width 200
2432label .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
2433        -background lightsalmon -foreground black
2434text $ui_workdir -background white -foreground black \
2435        -borderwidth 0 \
2436        -width 20 -height 10 \
2437        -wrap none \
2438        -cursor $cursor_ptr \
2439        -xscrollcommand {.vpane.files.workdir.sx set} \
2440        -yscrollcommand {.vpane.files.workdir.sy set} \
2441        -state disabled
2442scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
2443scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
2444pack .vpane.files.workdir.title -side top -fill x
2445pack .vpane.files.workdir.sx -side bottom -fill x
2446pack .vpane.files.workdir.sy -side right -fill y
2447pack $ui_workdir -side left -fill both -expand 1
2448
2449.vpane.files add .vpane.files.workdir -sticky nsew
2450.vpane.files add .vpane.files.index -sticky nsew
2451
2452foreach i [list $ui_index $ui_workdir] {
2453        rmsel_tag $i
2454        $i tag conf in_diff -background [$i tag cget in_sel -background]
2455}
2456unset i
2457
2458# -- Diff and Commit Area
2459#
2460frame .vpane.lower -height 300 -width 400
2461frame .vpane.lower.commarea
2462frame .vpane.lower.diff -relief sunken -borderwidth 1
2463pack .vpane.lower.diff -fill both -expand 1
2464pack .vpane.lower.commarea -side bottom -fill x
2465.vpane add .vpane.lower -sticky nsew
2466
2467# -- Commit Area Buttons
2468#
2469frame .vpane.lower.commarea.buttons
2470label .vpane.lower.commarea.buttons.l -text {} \
2471        -anchor w \
2472        -justify left
2473pack .vpane.lower.commarea.buttons.l -side top -fill x
2474pack .vpane.lower.commarea.buttons -side left -fill y
2475
2476button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
2477        -command do_rescan
2478pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2479lappend disable_on_lock \
2480        {.vpane.lower.commarea.buttons.rescan conf -state}
2481
2482button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
2483        -command do_add_all
2484pack .vpane.lower.commarea.buttons.incall -side top -fill x
2485lappend disable_on_lock \
2486        {.vpane.lower.commarea.buttons.incall conf -state}
2487
2488button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
2489        -command do_signoff
2490pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2491
2492button .vpane.lower.commarea.buttons.commit -text [mc Commit@@verb] \
2493        -command do_commit
2494pack .vpane.lower.commarea.buttons.commit -side top -fill x
2495lappend disable_on_lock \
2496        {.vpane.lower.commarea.buttons.commit conf -state}
2497
2498button .vpane.lower.commarea.buttons.push -text [mc Push] \
2499        -command do_push_anywhere
2500pack .vpane.lower.commarea.buttons.push -side top -fill x
2501
2502# -- Commit Message Buffer
2503#
2504frame .vpane.lower.commarea.buffer
2505frame .vpane.lower.commarea.buffer.header
2506set ui_comm .vpane.lower.commarea.buffer.t
2507set ui_coml .vpane.lower.commarea.buffer.header.l
2508radiobutton .vpane.lower.commarea.buffer.header.new \
2509        -text [mc "New Commit"] \
2510        -command do_select_commit_type \
2511        -variable selected_commit_type \
2512        -value new
2513lappend disable_on_lock \
2514        [list .vpane.lower.commarea.buffer.header.new conf -state]
2515radiobutton .vpane.lower.commarea.buffer.header.amend \
2516        -text [mc "Amend Last Commit"] \
2517        -command do_select_commit_type \
2518        -variable selected_commit_type \
2519        -value amend
2520lappend disable_on_lock \
2521        [list .vpane.lower.commarea.buffer.header.amend conf -state]
2522label $ui_coml \
2523        -anchor w \
2524        -justify left
2525proc trace_commit_type {varname args} {
2526        global ui_coml commit_type
2527        switch -glob -- $commit_type {
2528        initial       {set txt [mc "Initial Commit Message:"]}
2529        amend         {set txt [mc "Amended Commit Message:"]}
2530        amend-initial {set txt [mc "Amended Initial Commit Message:"]}
2531        amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
2532        merge         {set txt [mc "Merge Commit Message:"]}
2533        *             {set txt [mc "Commit Message:"]}
2534        }
2535        $ui_coml conf -text $txt
2536}
2537trace add variable commit_type write trace_commit_type
2538pack $ui_coml -side left -fill x
2539pack .vpane.lower.commarea.buffer.header.amend -side right
2540pack .vpane.lower.commarea.buffer.header.new -side right
2541
2542text $ui_comm -background white -foreground black \
2543        -borderwidth 1 \
2544        -undo true \
2545        -maxundo 20 \
2546        -autoseparators true \
2547        -relief sunken \
2548        -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
2549        -font font_diff \
2550        -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2551scrollbar .vpane.lower.commarea.buffer.sby \
2552        -command [list $ui_comm yview]
2553pack .vpane.lower.commarea.buffer.header -side top -fill x
2554pack .vpane.lower.commarea.buffer.sby -side right -fill y
2555pack $ui_comm -side left -fill y
2556pack .vpane.lower.commarea.buffer -side left -fill y
2557
2558# -- Commit Message Buffer Context Menu
2559#
2560set ctxm .vpane.lower.commarea.buffer.ctxm
2561menu $ctxm -tearoff 0
2562$ctxm add command \
2563        -label [mc Cut] \
2564        -command {tk_textCut $ui_comm}
2565$ctxm add command \
2566        -label [mc Copy] \
2567        -command {tk_textCopy $ui_comm}
2568$ctxm add command \
2569        -label [mc Paste] \
2570        -command {tk_textPaste $ui_comm}
2571$ctxm add command \
2572        -label [mc Delete] \
2573        -command {$ui_comm delete sel.first sel.last}
2574$ctxm add separator
2575$ctxm add command \
2576        -label [mc "Select All"] \
2577        -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
2578$ctxm add command \
2579        -label [mc "Copy All"] \
2580        -command {
2581                $ui_comm tag add sel 0.0 end
2582                tk_textCopy $ui_comm
2583                $ui_comm tag remove sel 0.0 end
2584        }
2585$ctxm add separator
2586$ctxm add command \
2587        -label [mc "Sign Off"] \
2588        -command do_signoff
2589set ui_comm_ctxm $ctxm
2590
2591# -- Diff Header
2592#
2593proc trace_current_diff_path {varname args} {
2594        global current_diff_path diff_actions file_states
2595        if {$current_diff_path eq {}} {
2596                set s {}
2597                set f {}
2598                set p {}
2599                set o disabled
2600        } else {
2601                set p $current_diff_path
2602                set s [mapdesc [lindex $file_states($p) 0] $p]
2603                set f [mc "File:"]
2604                set p [escape_path $p]
2605                set o normal
2606        }
2607
2608        .vpane.lower.diff.header.status configure -text $s
2609        .vpane.lower.diff.header.file configure -text $f
2610        .vpane.lower.diff.header.path configure -text $p
2611        foreach w $diff_actions {
2612                uplevel #0 $w $o
2613        }
2614}
2615trace add variable current_diff_path write trace_current_diff_path
2616
2617frame .vpane.lower.diff.header -background gold
2618label .vpane.lower.diff.header.status \
2619        -background gold \
2620        -foreground black \
2621        -width $max_status_desc \
2622        -anchor w \
2623        -justify left
2624label .vpane.lower.diff.header.file \
2625        -background gold \
2626        -foreground black \
2627        -anchor w \
2628        -justify left
2629label .vpane.lower.diff.header.path \
2630        -background gold \
2631        -foreground black \
2632        -anchor w \
2633        -justify left
2634pack .vpane.lower.diff.header.status -side left
2635pack .vpane.lower.diff.header.file -side left
2636pack .vpane.lower.diff.header.path -fill x
2637set ctxm .vpane.lower.diff.header.ctxm
2638menu $ctxm -tearoff 0
2639$ctxm add command \
2640        -label [mc Copy] \
2641        -command {
2642                clipboard clear
2643                clipboard append \
2644                        -format STRING \
2645                        -type STRING \
2646                        -- $current_diff_path
2647        }
2648lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2649bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2650
2651# -- Diff Body
2652#
2653frame .vpane.lower.diff.body
2654set ui_diff .vpane.lower.diff.body.t
2655text $ui_diff -background white -foreground black \
2656        -borderwidth 0 \
2657        -width 80 -height 15 -wrap none \
2658        -font font_diff \
2659        -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2660        -yscrollcommand {.vpane.lower.diff.body.sby set} \
2661        -state disabled
2662scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2663        -command [list $ui_diff xview]
2664scrollbar .vpane.lower.diff.body.sby -orient vertical \
2665        -command [list $ui_diff yview]
2666pack .vpane.lower.diff.body.sbx -side bottom -fill x
2667pack .vpane.lower.diff.body.sby -side right -fill y
2668pack $ui_diff -side left -fill both -expand 1
2669pack .vpane.lower.diff.header -side top -fill x
2670pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2671
2672$ui_diff tag conf d_cr -elide true
2673$ui_diff tag conf d_@ -foreground blue -font font_diffbold
2674$ui_diff tag conf d_+ -foreground {#00a000}
2675$ui_diff tag conf d_- -foreground red
2676
2677$ui_diff tag conf d_++ -foreground {#00a000}
2678$ui_diff tag conf d_-- -foreground red
2679$ui_diff tag conf d_+s \
2680        -foreground {#00a000} \
2681        -background {#e2effa}
2682$ui_diff tag conf d_-s \
2683        -foreground red \
2684        -background {#e2effa}
2685$ui_diff tag conf d_s+ \
2686        -foreground {#00a000} \
2687        -background ivory1
2688$ui_diff tag conf d_s- \
2689        -foreground red \
2690        -background ivory1
2691
2692$ui_diff tag conf d<<<<<<< \
2693        -foreground orange \
2694        -font font_diffbold
2695$ui_diff tag conf d======= \
2696        -foreground orange \
2697        -font font_diffbold
2698$ui_diff tag conf d>>>>>>> \
2699        -foreground orange \
2700        -font font_diffbold
2701
2702$ui_diff tag raise sel
2703
2704# -- Diff Body Context Menu
2705#
2706set ctxm .vpane.lower.diff.body.ctxm
2707menu $ctxm -tearoff 0
2708$ctxm add command \
2709        -label [mc "Apply/Reverse Hunk"] \
2710        -command {apply_hunk $cursorX $cursorY}
2711set ui_diff_applyhunk [$ctxm index last]
2712lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
2713$ctxm add command \
2714        -label [mc "Apply/Reverse Line"] \
2715        -command {apply_line $cursorX $cursorY; do_rescan}
2716set ui_diff_applyline [$ctxm index last]
2717lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
2718$ctxm add separator
2719$ctxm add command \
2720        -label [mc "Show Less Context"] \
2721        -command show_less_context
2722lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2723$ctxm add command \
2724        -label [mc "Show More Context"] \
2725        -command show_more_context
2726lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2727$ctxm add separator
2728$ctxm add command \
2729        -label [mc Refresh] \
2730        -command reshow_diff
2731lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2732$ctxm add command \
2733        -label [mc Copy] \
2734        -command {tk_textCopy $ui_diff}
2735lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2736$ctxm add command \
2737        -label [mc "Select All"] \
2738        -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
2739lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2740$ctxm add command \
2741        -label [mc "Copy All"] \
2742        -command {
2743                $ui_diff tag add sel 0.0 end
2744                tk_textCopy $ui_diff
2745                $ui_diff tag remove sel 0.0 end
2746        }
2747lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2748$ctxm add separator
2749$ctxm add command \
2750        -label [mc "Decrease Font Size"] \
2751        -command {incr_font_size font_diff -1}
2752lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2753$ctxm add command \
2754        -label [mc "Increase Font Size"] \
2755        -command {incr_font_size font_diff 1}
2756lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2757$ctxm add separator
2758$ctxm add command -label [mc "Options..."] \
2759        -command do_options
2760proc popup_diff_menu {ctxm x y X Y} {
2761        global current_diff_path file_states
2762        set ::cursorX $x
2763        set ::cursorY $y
2764        if {$::ui_index eq $::current_diff_side} {
2765                set l [mc "Unstage Hunk From Commit"]
2766                set t [mc "Unstage Line From Commit"]
2767        } else {
2768                set l [mc "Stage Hunk For Commit"]
2769                set t [mc "Stage Line For Commit"]
2770        }
2771        if {$::is_3way_diff
2772                || $current_diff_path eq {}
2773                || ![info exists file_states($current_diff_path)]
2774                || {_O} eq [lindex $file_states($current_diff_path) 0]
2775                || {_T} eq [lindex $file_states($current_diff_path) 0]
2776                || {T_} eq [lindex $file_states($current_diff_path) 0]} {
2777                set s disabled
2778        } else {
2779                set s normal
2780        }
2781        $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
2782        $ctxm entryconf $::ui_diff_applyline -state $s -label $t
2783        tk_popup $ctxm $X $Y
2784}
2785bind_button3 $ui_diff [list popup_diff_menu $ctxm %x %y %X %Y]
2786
2787# -- Status Bar
2788#
2789set main_status [::status_bar::new .status]
2790pack .status -anchor w -side bottom -fill x
2791$main_status show [mc "Initializing..."]
2792
2793# -- Load geometry
2794#
2795catch {
2796set gm $repo_config(gui.geometry)
2797wm geometry . [lindex $gm 0]
2798.vpane sash place 0 \
2799        [lindex $gm 1] \
2800        [lindex [.vpane sash coord 0] 1]
2801.vpane.files sash place 0 \
2802        [lindex [.vpane.files sash coord 0] 0] \
2803        [lindex $gm 2]
2804unset gm
2805}
2806
2807# -- Key Bindings
2808#
2809bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2810bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
2811bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
2812bind $ui_comm <$M1B-Key-i> {do_add_all;break}
2813bind $ui_comm <$M1B-Key-I> {do_add_all;break}
2814bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2815bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2816bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2817bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2818bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2819bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2820bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2821bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2822bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
2823bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
2824bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
2825bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
2826bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
2827
2828bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2829bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2830bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2831bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2832bind $ui_diff <$M1B-Key-v> {break}
2833bind $ui_diff <$M1B-Key-V> {break}
2834bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2835bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2836bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2837bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2838bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2839bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2840bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
2841bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
2842bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
2843bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
2844bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
2845bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
2846bind $ui_diff <Button-1>   {focus %W}
2847
2848if {[is_enabled branch]} {
2849        bind . <$M1B-Key-n> branch_create::dialog
2850        bind . <$M1B-Key-N> branch_create::dialog
2851        bind . <$M1B-Key-o> branch_checkout::dialog
2852        bind . <$M1B-Key-O> branch_checkout::dialog
2853        bind . <$M1B-Key-m> merge::dialog
2854        bind . <$M1B-Key-M> merge::dialog
2855}
2856if {[is_enabled transport]} {
2857        bind . <$M1B-Key-p> do_push_anywhere
2858        bind . <$M1B-Key-P> do_push_anywhere
2859}
2860
2861bind .   <Key-F5>     do_rescan
2862bind .   <$M1B-Key-r> do_rescan
2863bind .   <$M1B-Key-R> do_rescan
2864bind .   <$M1B-Key-s> do_signoff
2865bind .   <$M1B-Key-S> do_signoff
2866bind .   <$M1B-Key-t> do_add_selection
2867bind .   <$M1B-Key-T> do_add_selection
2868bind .   <$M1B-Key-i> do_add_all
2869bind .   <$M1B-Key-I> do_add_all
2870bind .   <$M1B-Key-minus> {show_less_context;break}
2871bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
2872bind .   <$M1B-Key-equal> {show_more_context;break}
2873bind .   <$M1B-Key-plus> {show_more_context;break}
2874bind .   <$M1B-Key-KP_Add> {show_more_context;break}
2875bind .   <$M1B-Key-Return> do_commit
2876foreach i [list $ui_index $ui_workdir] {
2877        bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2878        bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2879        bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2880}
2881unset i
2882
2883set file_lists($ui_index) [list]
2884set file_lists($ui_workdir) [list]
2885
2886wm title . "[appname] ([reponame]) [file normalize [file dirname [gitdir]]]"
2887focus -force $ui_comm
2888
2889# -- Warn the user about environmental problems.  Cygwin's Tcl
2890#    does *not* pass its env array onto any processes it spawns.
2891#    This means that git processes get none of our environment.
2892#
2893if {[is_Cygwin]} {
2894        set ignored_env 0
2895        set suggest_user {}
2896        set msg [mc "Possible environment issues exist.
2897
2898The following environment variables are probably
2899going to be ignored by any Git subprocess run
2900by %s:
2901
2902" [appname]]
2903        foreach name [array names env] {
2904                switch -regexp -- $name {
2905                {^GIT_INDEX_FILE$} -
2906                {^GIT_OBJECT_DIRECTORY$} -
2907                {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
2908                {^GIT_DIFF_OPTS$} -
2909                {^GIT_EXTERNAL_DIFF$} -
2910                {^GIT_PAGER$} -
2911                {^GIT_TRACE$} -
2912                {^GIT_CONFIG$} -
2913                {^GIT_CONFIG_LOCAL$} -
2914                {^GIT_(AUTHOR|COMMITTER)_DATE$} {
2915                        append msg " - $name\n"
2916                        incr ignored_env
2917                }
2918                {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
2919                        append msg " - $name\n"
2920                        incr ignored_env
2921                        set suggest_user $name
2922                }
2923                }
2924        }
2925        if {$ignored_env > 0} {
2926                append msg [mc "
2927This is due to a known issue with the
2928Tcl binary distributed by Cygwin."]
2929
2930                if {$suggest_user ne {}} {
2931                        append msg [mc "
2932
2933A good replacement for %s
2934is placing values for the user.name and
2935user.email settings into your personal
2936~/.gitconfig file.
2937" $suggest_user]
2938                }
2939                warn_popup $msg
2940        }
2941        unset ignored_env msg suggest_user name
2942}
2943
2944# -- Only initialize complex UI if we are going to stay running.
2945#
2946if {[is_enabled transport]} {
2947        load_all_remotes
2948
2949        set n [.mbar.remote index end]
2950        populate_push_menu
2951        populate_fetch_menu
2952        set n [expr {[.mbar.remote index end] - $n}]
2953        if {$n > 0} {
2954                if {[.mbar.remote type 0] eq "tearoff"} { incr n }
2955                .mbar.remote insert $n separator
2956        }
2957        unset n
2958}
2959
2960if {[winfo exists $ui_comm]} {
2961        set GITGUI_BCK_exists [load_message GITGUI_BCK]
2962
2963        # -- If both our backup and message files exist use the
2964        #    newer of the two files to initialize the buffer.
2965        #
2966        if {$GITGUI_BCK_exists} {
2967                set m [gitdir GITGUI_MSG]
2968                if {[file isfile $m]} {
2969                        if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
2970                                catch {file delete [gitdir GITGUI_MSG]}
2971                        } else {
2972                                $ui_comm delete 0.0 end
2973                                $ui_comm edit reset
2974                                $ui_comm edit modified false
2975                                catch {file delete [gitdir GITGUI_BCK]}
2976                                set GITGUI_BCK_exists 0
2977                        }
2978                }
2979                unset m
2980        }
2981
2982        proc backup_commit_buffer {} {
2983                global ui_comm GITGUI_BCK_exists
2984
2985                set m [$ui_comm edit modified]
2986                if {$m || $GITGUI_BCK_exists} {
2987                        set msg [string trim [$ui_comm get 0.0 end]]
2988                        regsub -all -line {[ \r\t]+$} $msg {} msg
2989
2990                        if {$msg eq {}} {
2991                                if {$GITGUI_BCK_exists} {
2992                                        catch {file delete [gitdir GITGUI_BCK]}
2993                                        set GITGUI_BCK_exists 0
2994                                }
2995                        } elseif {$m} {
2996                                catch {
2997                                        set fd [open [gitdir GITGUI_BCK] w]
2998                                        puts -nonewline $fd $msg
2999                                        close $fd
3000                                        set GITGUI_BCK_exists 1
3001                                }
3002                        }
3003
3004                        $ui_comm edit modified false
3005                }
3006
3007                set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3008        }
3009
3010        backup_commit_buffer
3011
3012        # -- If the user has aspell available we can drive it
3013        #    in pipe mode to spellcheck the commit message.
3014        #
3015        set spell_cmd [list |]
3016        set spell_dict [get_config gui.spellingdictionary]
3017        lappend spell_cmd aspell
3018        if {$spell_dict ne {}} {
3019                lappend spell_cmd --master=$spell_dict
3020        }
3021        lappend spell_cmd --mode=none
3022        lappend spell_cmd --encoding=utf-8
3023        lappend spell_cmd pipe
3024        if {$spell_dict eq {none}
3025         || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3026                bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3027        } else {
3028                set ui_comm_spell [spellcheck::init \
3029                        $spell_fd \
3030                        $ui_comm \
3031                        $ui_comm_ctxm \
3032                ]
3033        }
3034        unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3035}
3036
3037lock_index begin-read
3038if {![winfo ismapped .]} {
3039        wm deiconify .
3040}
3041after 1 do_rescan
3042if {[is_enabled multicommit]} {
3043        after 1000 hint_gc
3044}