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