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