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