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