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