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