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