git.oblomov.eu Git - git/blob - git-gui.sh

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