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