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