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