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