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