Andrew's git - gitweb.git/blob

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