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