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