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