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