git.oblomov.eu Git - git/blob - git-gui/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 [string map [list (c) \u00a9] {
  14 Copyright (c) 2006-2010 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 "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 _gitworktree {}
 125 set _isbare {}
 126 set _gitexec {}
 127 set _githtmldir {}
 128 set _reponame {}
 129 set _iscygwin {}
 130 set _search_path {}
 131 set _shellpath {@@SHELL_PATH@@}
 132
 133 set _trace [lsearch -exact $argv --trace]
 134 if {$_trace >= 0} {
 135         set argv [lreplace $argv $_trace $_trace]
 136         set _trace 1
 137 } else {
 138         set _trace 0
 139 }
 140
 141 proc shellpath {} {
 142         global _shellpath env
 143         if {[string match @@* $_shellpath]} {
 144                 if {[info exists env(SHELL)]} {
 145                         return $env(SHELL)
 146                 } else {
 147                         return /bin/sh
 148                 }
 149         }
 150         return $_shellpath
 151 }
 152
 153 proc appname {} {
 154         global _appname
 155         return $_appname
 156 }
 157
 158 proc gitdir {args} {
 159         global _gitdir
 160         if {$args eq {}} {
 161                 return $_gitdir
 162         }
 163         return [eval [list file join $_gitdir] $args]
 164 }
 165
 166 proc gitexec {args} {
 167         global _gitexec
 168         if {$_gitexec eq {}} {
 169                 if {[catch {set _gitexec [git --exec-path]} err]} {
 170                         error "Git not installed?\n\n$err"
 171                 }
 172                 if {[is_Cygwin]} {
 173                         set _gitexec [exec cygpath \
 174                                 --windows \
 175                                 --absolute \
 176                                 $_gitexec]
 177                 } else {
 178                         set _gitexec [file normalize $_gitexec]
 179                 }
 180         }
 181         if {$args eq {}} {
 182                 return $_gitexec
 183         }
 184         return [eval [list file join $_gitexec] $args]
 185 }
 186
 187 proc githtmldir {args} {
 188         global _githtmldir
 189         if {$_githtmldir eq {}} {
 190                 if {[catch {set _githtmldir [git --html-path]}]} {
 191                         # Git not installed or option not yet supported
 192                         return {}
 193                 }
 194                 if {[is_Cygwin]} {
 195                         set _githtmldir [exec cygpath \
 196                                 --windows \
 197                                 --absolute \
 198                                 $_githtmldir]
 199                 } else {
 200                         set _githtmldir [file normalize $_githtmldir]
 201                 }
 202         }
 203         if {$args eq {}} {
 204                 return $_githtmldir
 205         }
 206         return [eval [list file join $_githtmldir] $args]
 207 }
 208
 209 proc reponame {} {
 210         return $::_reponame
 211 }
 212
 213 proc is_MacOSX {} {
 214         if {[tk windowingsystem] eq {aqua}} {
 215                 return 1
 216         }
 217         return 0
 218 }
 219
 220 proc is_Windows {} {
 221         if {$::tcl_platform(platform) eq {windows}} {
 222                 return 1
 223         }
 224         return 0
 225 }
 226
 227 proc is_Cygwin {} {
 228         global _iscygwin
 229         if {$_iscygwin eq {}} {
 230                 if {$::tcl_platform(platform) eq {windows}} {
 231                         if {[catch {set p [exec cygpath --windir]} err]} {
 232                                 set _iscygwin 0
 233                         } else {
 234                                 set _iscygwin 1
 235                         }
 236                 } else {
 237                         set _iscygwin 0
 238                 }
 239         }
 240         return $_iscygwin
 241 }
 242
 243 proc is_enabled {option} {
 244         global enabled_options
 245         if {[catch {set on $enabled_options($option)}]} {return 0}
 246         return $on
 247 }
 248
 249 proc enable_option {option} {
 250         global enabled_options
 251         set enabled_options($option) 1
 252 }
 253
 254 proc disable_option {option} {
 255         global enabled_options
 256         set enabled_options($option) 0
 257 }
 258
 259 ######################################################################
 260 ##
 261 ## config
 262
 263 proc is_many_config {name} {
 264         switch -glob -- $name {
 265         gui.recentrepo -
 266         remote.*.fetch -
 267         remote.*.push
 268                 {return 1}
 269         *
 270                 {return 0}
 271         }
 272 }
 273
 274 proc is_config_true {name} {
 275         global repo_config
 276         if {[catch {set v $repo_config($name)}]} {
 277                 return 0
 278         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 279                 return 1
 280         } else {
 281                 return 0
 282         }
 283 }
 284
 285 proc is_config_false {name} {
 286         global repo_config
 287         if {[catch {set v $repo_config($name)}]} {
 288                 return 0
 289         } elseif {$v eq {false} || $v eq {0} || $v eq {no}} {
 290                 return 1
 291         } else {
 292                 return 0
 293         }
 294 }
 295
 296 proc get_config {name} {
 297         global repo_config
 298         if {[catch {set v $repo_config($name)}]} {
 299                 return {}
 300         } else {
 301                 return $v
 302         }
 303 }
 304
 305 proc is_bare {} {
 306         global _isbare
 307         global _gitdir
 308         global _gitworktree
 309
 310         if {$_isbare eq {}} {
 311                 if {[catch {
 312                         set _bare [git rev-parse --is-bare-repository]
 313                         switch  -- $_bare {
 314                         true { set _isbare 1 }
 315                         false { set _isbare 0}
 316                         default { throw }
 317                         }
 318                 }]} {
 319                         if {[is_config_true core.bare]
 320                                 || ($_gitworktree eq {}
 321                                         && [lindex [file split $_gitdir] end] ne {.git})} {
 322                                 set _isbare 1
 323                         } else {
 324                                 set _isbare 0
 325                         }
 326                 }
 327         }
 328         return $_isbare
 329 }
 330
 331 ######################################################################
 332 ##
 333 ## handy utils
 334
 335 proc _trace_exec {cmd} {
 336         if {!$::_trace} return
 337         set d {}
 338         foreach v $cmd {
 339                 if {$d ne {}} {
 340                         append d { }
 341                 }
 342                 if {[regexp {[ \t\r\n'"$?*]} $v]} {
 343                         set v [sq $v]
 344                 }
 345                 append d $v
 346         }
 347         puts stderr $d
 348 }
 349
 350 #'"  fix poor old emacs font-lock mode
 351
 352 proc _git_cmd {name} {
 353         global _git_cmd_path
 354
 355         if {[catch {set v $_git_cmd_path($name)}]} {
 356                 switch -- $name {
 357                   version   -
 358                 --version   -
 359                 --exec-path { return [list $::_git $name] }
 360                 }
 361
 362                 set p [gitexec git-$name$::_search_exe]
 363                 if {[file exists $p]} {
 364                         set v [list $p]
 365                 } elseif {[is_Windows] && [file exists [gitexec git-$name]]} {
 366                         # Try to determine what sort of magic will make
 367                         # git-$name go and do its thing, because native
 368                         # Tcl on Windows doesn't know it.
 369                         #
 370                         set p [gitexec git-$name]
 371                         set f [open $p r]
 372                         set s [gets $f]
 373                         close $f
 374
 375                         switch -glob -- [lindex $s 0] {
 376                         #!*sh     { set i sh     }
 377                         #!*perl   { set i perl   }
 378                         #!*python { set i python }
 379                         default   { error "git-$name is not supported: $s" }
 380                         }
 381
 382                         upvar #0 _$i interp
 383                         if {![info exists interp]} {
 384                                 set interp [_which $i]
 385                         }
 386                         if {$interp eq {}} {
 387                                 error "git-$name requires $i (not in PATH)"
 388                         }
 389                         set v [concat [list $interp] [lrange $s 1 end] [list $p]]
 390                 } else {
 391                         # Assume it is builtin to git somehow and we
 392                         # aren't actually able to see a file for it.
 393                         #
 394                         set v [list $::_git $name]
 395                 }
 396                 set _git_cmd_path($name) $v
 397         }
 398         return $v
 399 }
 400
 401 proc _which {what args} {
 402         global env _search_exe _search_path
 403
 404         if {$_search_path eq {}} {
 405                 if {[is_Cygwin] && [regexp {^(/|\.:)} $env(PATH)]} {
 406                         set _search_path [split [exec cygpath \
 407                                 --windows \
 408                                 --path \
 409                                 --absolute \
 410                                 $env(PATH)] {;}]
 411                         set _search_exe .exe
 412                 } elseif {[is_Windows]} {
 413                         set gitguidir [file dirname [info script]]
 414                         regsub -all ";" $gitguidir "\\;" gitguidir
 415                         set env(PATH) "$gitguidir;$env(PATH)"
 416                         set _search_path [split $env(PATH) {;}]
 417                         set _search_exe .exe
 418                 } else {
 419                         set _search_path [split $env(PATH) :]
 420                         set _search_exe {}
 421                 }
 422         }
 423
 424         if {[is_Windows] && [lsearch -exact $args -script] >= 0} {
 425                 set suffix {}
 426         } else {
 427                 set suffix $_search_exe
 428         }
 429
 430         foreach p $_search_path {
 431                 set p [file join $p $what$suffix]
 432                 if {[file exists $p]} {
 433                         return [file normalize $p]
 434                 }
 435         }
 436         return {}
 437 }
 438
 439 proc _lappend_nice {cmd_var} {
 440         global _nice
 441         upvar $cmd_var cmd
 442
 443         if {![info exists _nice]} {
 444                 set _nice [_which nice]
 445                 if {[catch {exec $_nice git version}]} {
 446                         set _nice {}
 447                 }
 448         }
 449         if {$_nice ne {}} {
 450                 lappend cmd $_nice
 451         }
 452 }
 453
 454 proc git {args} {
 455         set opt [list]
 456
 457         while {1} {
 458                 switch -- [lindex $args 0] {
 459                 --nice {
 460                         _lappend_nice opt
 461                 }
 462
 463                 default {
 464                         break
 465                 }
 466
 467                 }
 468
 469                 set args [lrange $args 1 end]
 470         }
 471
 472         set cmdp [_git_cmd [lindex $args 0]]
 473         set args [lrange $args 1 end]
 474
 475         _trace_exec [concat $opt $cmdp $args]
 476         set result [eval exec $opt $cmdp $args]
 477         if {$::_trace} {
 478                 puts stderr "< $result"
 479         }
 480         return $result
 481 }
 482
 483 proc _open_stdout_stderr {cmd} {
 484         _trace_exec $cmd
 485         if {[catch {
 486                         set fd [open [concat [list | ] $cmd] r]
 487                 } err]} {
 488                 if {   [lindex $cmd end] eq {2>@1}
 489                     && $err eq {can not find channel named "1"}
 490                         } {
 491                         # Older versions of Tcl 8.4 don't have this 2>@1 IO
 492                         # redirect operator.  Fallback to |& cat for those.
 493                         # The command was not actually started, so its safe
 494                         # to try to start it a second time.
 495                         #
 496                         set fd [open [concat \
 497                                 [list | ] \
 498                                 [lrange $cmd 0 end-1] \
 499                                 [list |& cat] \
 500                                 ] r]
 501                 } else {
 502                         error $err
 503                 }
 504         }
 505         fconfigure $fd -eofchar {}
 506         return $fd
 507 }
 508
 509 proc git_read {args} {
 510         set opt [list]
 511
 512         while {1} {
 513                 switch -- [lindex $args 0] {
 514                 --nice {
 515                         _lappend_nice opt
 516                 }
 517
 518                 --stderr {
 519                         lappend args 2>@1
 520                 }
 521
 522                 default {
 523                         break
 524                 }
 525
 526                 }
 527
 528                 set args [lrange $args 1 end]
 529         }
 530
 531         set cmdp [_git_cmd [lindex $args 0]]
 532         set args [lrange $args 1 end]
 533
 534         return [_open_stdout_stderr [concat $opt $cmdp $args]]
 535 }
 536
 537 proc git_write {args} {
 538         set opt [list]
 539
 540         while {1} {
 541                 switch -- [lindex $args 0] {
 542                 --nice {
 543                         _lappend_nice opt
 544                 }
 545
 546                 default {
 547                         break
 548                 }
 549
 550                 }
 551
 552                 set args [lrange $args 1 end]
 553         }
 554
 555         set cmdp [_git_cmd [lindex $args 0]]
 556         set args [lrange $args 1 end]
 557
 558         _trace_exec [concat $opt $cmdp $args]
 559         return [open [concat [list | ] $opt $cmdp $args] w]
 560 }
 561
 562 proc githook_read {hook_name args} {
 563         set pchook [gitdir hooks $hook_name]
 564         lappend args 2>@1
 565
 566         # On Windows [file executable] might lie so we need to ask
 567         # the shell if the hook is executable.  Yes that's annoying.
 568         #
 569         if {[is_Windows]} {
 570                 upvar #0 _sh interp
 571                 if {![info exists interp]} {
 572                         set interp [_which sh]
 573                 }
 574                 if {$interp eq {}} {
 575                         error "hook execution requires sh (not in PATH)"
 576                 }
 577
 578                 set scr {if test -x "$1";then exec "$@";fi}
 579                 set sh_c [list $interp -c $scr $interp $pchook]
 580                 return [_open_stdout_stderr [concat $sh_c $args]]
 581         }
 582
 583         if {[file executable $pchook]} {
 584                 return [_open_stdout_stderr [concat [list $pchook] $args]]
 585         }
 586
 587         return {}
 588 }
 589
 590 proc kill_file_process {fd} {
 591         set process [pid $fd]
 592
 593         catch {
 594                 if {[is_Windows]} {
 595                         # Use a Cygwin-specific flag to allow killing
 596                         # native Windows processes
 597                         exec kill -f $process
 598                 } else {
 599                         exec kill $process
 600                 }
 601         }
 602 }
 603
 604 proc gitattr {path attr default} {
 605         if {[catch {set r [git check-attr $attr -- $path]}]} {
 606                 set r unspecified
 607         } else {
 608                 set r [join [lrange [split $r :] 2 end] :]
 609                 regsub {^ } $r {} r
 610         }
 611         if {$r eq {unspecified}} {
 612                 return $default
 613         }
 614         return $r
 615 }
 616
 617 proc sq {value} {
 618         regsub -all ' $value "'\\''" value
 619         return "'$value'"
 620 }
 621
 622 proc load_current_branch {} {
 623         global current_branch is_detached
 624
 625         set fd [open [gitdir HEAD] r]
 626         if {[gets $fd ref] < 1} {
 627                 set ref {}
 628         }
 629         close $fd
 630
 631         set pfx {ref: refs/heads/}
 632         set len [string length $pfx]
 633         if {[string equal -length $len $pfx $ref]} {
 634                 # We're on a branch.  It might not exist.  But
 635                 # HEAD looks good enough to be a branch.
 636                 #
 637                 set current_branch [string range $ref $len end]
 638                 set is_detached 0
 639         } else {
 640                 # Assume this is a detached head.
 641                 #
 642                 set current_branch HEAD
 643                 set is_detached 1
 644         }
 645 }
 646
 647 auto_load tk_optionMenu
 648 rename tk_optionMenu real__tkOptionMenu
 649 proc tk_optionMenu {w varName args} {
 650         set m [eval real__tkOptionMenu $w $varName $args]
 651         $m configure -font font_ui
 652         $w configure -font font_ui
 653         return $m
 654 }
 655
 656 proc rmsel_tag {text} {
 657         $text tag conf sel \
 658                 -background [$text cget -background] \
 659                 -foreground [$text cget -foreground] \
 660                 -borderwidth 0
 661         $text tag conf in_sel -background lightgray
 662         bind $text <Motion> break
 663         return $text
 664 }
 665
 666 wm withdraw .
 667 set root_exists 0
 668 bind . <Visibility> {
 669         bind . <Visibility> {}
 670         set root_exists 1
 671 }
 672
 673 if {[is_Windows]} {
 674         wm iconbitmap . -default $oguilib/git-gui.ico
 675         set ::tk::AlwaysShowSelection 1
 676
 677         # Spoof an X11 display for SSH
 678         if {![info exists env(DISPLAY)]} {
 679                 set env(DISPLAY) :9999
 680         }
 681 } else {
 682         catch {
 683                 image create photo gitlogo -width 16 -height 16
 684
 685                 gitlogo put #33CC33 -to  7  0  9  2
 686                 gitlogo put #33CC33 -to  4  2 12  4
 687                 gitlogo put #33CC33 -to  7  4  9  6
 688                 gitlogo put #CC3333 -to  4  6 12  8
 689                 gitlogo put gray26  -to  4  9  6 10
 690                 gitlogo put gray26  -to  3 10  6 12
 691                 gitlogo put gray26  -to  8  9 13 11
 692                 gitlogo put gray26  -to  8 11 10 12
 693                 gitlogo put gray26  -to 11 11 13 14
 694                 gitlogo put gray26  -to  3 12  5 14
 695                 gitlogo put gray26  -to  5 13
 696                 gitlogo put gray26  -to 10 13
 697                 gitlogo put gray26  -to  4 14 12 15
 698                 gitlogo put gray26  -to  5 15 11 16
 699                 gitlogo redither
 700
 701                 wm iconphoto . -default gitlogo
 702         }
 703 }
 704
 705 ######################################################################
 706 ##
 707 ## config defaults
 708
 709 set cursor_ptr arrow
 710 font create font_ui
 711 if {[lsearch -exact [font names] TkDefaultFont] != -1} {
 712         eval [linsert [font actual TkDefaultFont] 0 font configure font_ui]
 713         eval [linsert [font actual TkFixedFont] 0 font create font_diff]
 714 } else {
 715         font create font_diff -family Courier -size 10
 716         catch {
 717                 label .dummy
 718                 eval font configure font_ui [font actual [.dummy cget -font]]
 719                 destroy .dummy
 720         }
 721 }
 722
 723 font create font_uiitalic
 724 font create font_uibold
 725 font create font_diffbold
 726 font create font_diffitalic
 727
 728 foreach class {Button Checkbutton Entry Label
 729                 Labelframe Listbox Message
 730                 Radiobutton Spinbox Text} {
 731         option add *$class.font font_ui
 732 }
 733 if {![is_MacOSX]} {
 734         option add *Menu.font font_ui
 735         option add *Entry.borderWidth 1 startupFile
 736         option add *Entry.relief sunken startupFile
 737         option add *RadioButton.anchor w startupFile
 738 }
 739 unset class
 740
 741 if {[is_Windows] || [is_MacOSX]} {
 742         option add *Menu.tearOff 0
 743 }
 744
 745 if {[is_MacOSX]} {
 746         set M1B M1
 747         set M1T Cmd
 748 } else {
 749         set M1B Control
 750         set M1T Ctrl
 751 }
 752
 753 proc bind_button3 {w cmd} {
 754         bind $w <Any-Button-3> $cmd
 755         if {[is_MacOSX]} {
 756                 # Mac OS X sends Button-2 on right click through three-button mouse,
 757                 # or through trackpad right-clicking (two-finger touch + click).
 758                 bind $w <Any-Button-2> $cmd
 759                 bind $w <Control-Button-1> $cmd
 760         }
 761 }
 762
 763 proc apply_config {} {
 764         global repo_config font_descs
 765
 766         foreach option $font_descs {
 767                 set name [lindex $option 0]
 768                 set font [lindex $option 1]
 769                 if {[catch {
 770                         set need_weight 1
 771                         foreach {cn cv} $repo_config(gui.$name) {
 772                                 if {$cn eq {-weight}} {
 773                                         set need_weight 0
 774                                 }
 775                                 font configure $font $cn $cv
 776                         }
 777                         if {$need_weight} {
 778                                 font configure $font -weight normal
 779                         }
 780                         } err]} {
 781                         error_popup [strcat [mc "Invalid font specified in %s:" "gui.$name"] "\n\n$err"]
 782                 }
 783                 foreach {cn cv} [font configure $font] {
 784                         font configure ${font}bold $cn $cv
 785                         font configure ${font}italic $cn $cv
 786                 }
 787                 font configure ${font}bold -weight bold
 788                 font configure ${font}italic -slant italic
 789         }
 790
 791         global use_ttk NS
 792         set use_ttk 0
 793         set NS {}
 794         if {$repo_config(gui.usettk)} {
 795                 set use_ttk [package vsatisfies [package provide Tk] 8.5]
 796                 if {$use_ttk} {
 797                         set NS ttk
 798                         bind [winfo class .] <<ThemeChanged>> [list InitTheme]
 799                         pave_toplevel .
 800                 }
 801         }
 802 }
 803
 804 set default_config(branch.autosetupmerge) true
 805 set default_config(merge.tool) {}
 806 set default_config(mergetool.keepbackup) true
 807 set default_config(merge.diffstat) true
 808 set default_config(merge.summary) false
 809 set default_config(merge.verbosity) 2
 810 set default_config(user.name) {}
 811 set default_config(user.email) {}
 812
 813 set default_config(gui.encoding) [encoding system]
 814 set default_config(gui.matchtrackingbranch) false
 815 set default_config(gui.textconv) true
 816 set default_config(gui.pruneduringfetch) false
 817 set default_config(gui.trustmtime) false
 818 set default_config(gui.fastcopyblame) false
 819 set default_config(gui.copyblamethreshold) 40
 820 set default_config(gui.blamehistoryctx) 7
 821 set default_config(gui.diffcontext) 5
 822 set default_config(gui.commitmsgwidth) 75
 823 set default_config(gui.newbranchtemplate) {}
 824 set default_config(gui.spellingdictionary) {}
 825 set default_config(gui.fontui) [font configure font_ui]
 826 set default_config(gui.fontdiff) [font configure font_diff]
 827 # TODO: this option should be added to the git-config documentation
 828 set default_config(gui.maxfilesdisplayed) 5000
 829 set default_config(gui.usettk) 1
 830 set font_descs {
 831         {fontui   font_ui   {mc "Main Font"}}
 832         {fontdiff font_diff {mc "Diff/Console Font"}}
 833 }
 834
 835 ######################################################################
 836 ##
 837 ## find git
 838
 839 set _git  [_which git]
 840 if {$_git eq {}} {
 841         catch {wm withdraw .}
 842         tk_messageBox \
 843                 -icon error \
 844                 -type ok \
 845                 -title [mc "git-gui: fatal error"] \
 846                 -message [mc "Cannot find git in PATH."]
 847         exit 1
 848 }
 849
 850 ######################################################################
 851 ##
 852 ## version check
 853
 854 if {[catch {set _git_version [git --version]} err]} {
 855         catch {wm withdraw .}
 856         tk_messageBox \
 857                 -icon error \
 858                 -type ok \
 859                 -title [mc "git-gui: fatal error"] \
 860                 -message "Cannot determine Git version:
 861
 862 $err
 863
 864 [appname] requires Git 1.5.0 or later."
 865         exit 1
 866 }
 867 if {![regsub {^git version } $_git_version {} _git_version]} {
 868         catch {wm withdraw .}
 869         tk_messageBox \
 870                 -icon error \
 871                 -type ok \
 872                 -title [mc "git-gui: fatal error"] \
 873                 -message [strcat [mc "Cannot parse Git version string:"] "\n\n$_git_version"]
 874         exit 1
 875 }
 876
 877 set _real_git_version $_git_version
 878 regsub -- {[\-\.]dirty$} $_git_version {} _git_version
 879 regsub {\.[0-9]+\.g[0-9a-f]+$} $_git_version {} _git_version
 880 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
 881 regsub {\.GIT$} $_git_version {} _git_version
 882 regsub {\.[a-zA-Z]+\.?[0-9]+$} $_git_version {} _git_version
 883
 884 if {![regexp {^[1-9]+(\.[0-9]+)+$} $_git_version]} {
 885         catch {wm withdraw .}
 886         if {[tk_messageBox \
 887                 -icon warning \
 888                 -type yesno \
 889                 -default no \
 890                 -title "[appname]: warning" \
 891                  -message [mc "Git version cannot be determined.
 892
 893 %s claims it is version '%s'.
 894
 895 %s requires at least Git 1.5.0 or later.
 896
 897 Assume '%s' is version 1.5.0?
 898 " $_git $_real_git_version [appname] $_real_git_version]] eq {yes}} {
 899                 set _git_version 1.5.0
 900         } else {
 901                 exit 1
 902         }
 903 }
 904 unset _real_git_version
 905
 906 proc git-version {args} {
 907         global _git_version
 908
 909         switch [llength $args] {
 910         0 {
 911                 return $_git_version
 912         }
 913
 914         2 {
 915                 set op [lindex $args 0]
 916                 set vr [lindex $args 1]
 917                 set cm [package vcompare $_git_version $vr]
 918                 return [expr $cm $op 0]
 919         }
 920
 921         4 {
 922                 set type [lindex $args 0]
 923                 set name [lindex $args 1]
 924                 set parm [lindex $args 2]
 925                 set body [lindex $args 3]
 926
 927                 if {($type ne {proc} && $type ne {method})} {
 928                         error "Invalid arguments to git-version"
 929                 }
 930                 if {[llength $body] < 2 || [lindex $body end-1] ne {default}} {
 931                         error "Last arm of $type $name must be default"
 932                 }
 933
 934                 foreach {op vr cb} [lrange $body 0 end-2] {
 935                         if {[git-version $op $vr]} {
 936                                 return [uplevel [list $type $name $parm $cb]]
 937                         }
 938                 }
 939
 940                 return [uplevel [list $type $name $parm [lindex $body end]]]
 941         }
 942
 943         default {
 944                 error "git-version >= x"
 945         }
 946
 947         }
 948 }
 949
 950 if {[git-version < 1.5]} {
 951         catch {wm withdraw .}
 952         tk_messageBox \
 953                 -icon error \
 954                 -type ok \
 955                 -title [mc "git-gui: fatal error"] \
 956                 -message "[appname] requires Git 1.5.0 or later.
 957
 958 You are using [git-version]:
 959
 960 [git --version]"
 961         exit 1
 962 }
 963
 964 ######################################################################
 965 ##
 966 ## configure our library
 967
 968 set idx [file join $oguilib tclIndex]
 969 if {[catch {set fd [open $idx r]} err]} {
 970         catch {wm withdraw .}
 971         tk_messageBox \
 972                 -icon error \
 973                 -type ok \
 974                 -title [mc "git-gui: fatal error"] \
 975                 -message $err
 976         exit 1
 977 }
 978 if {[gets $fd] eq {# Autogenerated by git-gui Makefile}} {
 979         set idx [list]
 980         while {[gets $fd n] >= 0} {
 981                 if {$n ne {} && ![string match #* $n]} {
 982                         lappend idx $n
 983                 }
 984         }
 985 } else {
 986         set idx {}
 987 }
 988 close $fd
 989
 990 if {$idx ne {}} {
 991         set loaded [list]
 992         foreach p $idx {
 993                 if {[lsearch -exact $loaded $p] >= 0} continue
 994                 source [file join $oguilib $p]
 995                 lappend loaded $p
 996         }
 997         unset loaded p
 998 } else {
 999         set auto_path [concat [list $oguilib] $auto_path]
1000 }
1001 unset -nocomplain idx fd
1002
1003 ######################################################################
1004 ##
1005 ## config file parsing
1006
1007 git-version proc _parse_config {arr_name args} {
1008         >= 1.5.3 {
1009                 upvar $arr_name arr
1010                 array unset arr
1011                 set buf {}
1012                 catch {
1013                         set fd_rc [eval \
1014                                 [list git_read config] \
1015                                 $args \
1016                                 [list --null --list]]
1017                         fconfigure $fd_rc -translation binary
1018                         set buf [read $fd_rc]
1019                         close $fd_rc
1020                 }
1021                 foreach line [split $buf "\0"] {
1022                         if {[regexp {^([^\n]+)\n(.*)$} $line line name value]} {
1023                                 if {[is_many_config $name]} {
1024                                         lappend arr($name) $value
1025                                 } else {
1026                                         set arr($name) $value
1027                                 }
1028                         }
1029                 }
1030         }
1031         default {
1032                 upvar $arr_name arr
1033                 array unset arr
1034                 catch {
1035                         set fd_rc [eval [list git_read config --list] $args]
1036                         while {[gets $fd_rc line] >= 0} {
1037                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
1038                                         if {[is_many_config $name]} {
1039                                                 lappend arr($name) $value
1040                                         } else {
1041                                                 set arr($name) $value
1042                                         }
1043                                 }
1044                         }
1045                         close $fd_rc
1046                 }
1047         }
1048 }
1049
1050 proc load_config {include_global} {
1051         global repo_config global_config system_config default_config
1052
1053         if {$include_global} {
1054                 _parse_config system_config --system
1055                 _parse_config global_config --global
1056         }
1057         _parse_config repo_config
1058
1059         foreach name [array names default_config] {
1060                 if {[catch {set v $system_config($name)}]} {
1061                         set system_config($name) $default_config($name)
1062                 }
1063         }
1064         foreach name [array names system_config] {
1065                 if {[catch {set v $global_config($name)}]} {
1066                         set global_config($name) $system_config($name)
1067                 }
1068                 if {[catch {set v $repo_config($name)}]} {
1069                         set repo_config($name) $system_config($name)
1070                 }
1071         }
1072 }
1073
1074 ######################################################################
1075 ##
1076 ## feature option selection
1077
1078 if {[regexp {^git-(.+)$} [file tail $argv0] _junk subcommand]} {
1079         unset _junk
1080 } else {
1081         set subcommand gui
1082 }
1083 if {$subcommand eq {gui.sh}} {
1084         set subcommand gui
1085 }
1086 if {$subcommand eq {gui} && [llength $argv] > 0} {
1087         set subcommand [lindex $argv 0]
1088         set argv [lrange $argv 1 end]
1089 }
1090
1091 enable_option multicommit
1092 enable_option branch
1093 enable_option transport
1094 disable_option bare
1095
1096 switch -- $subcommand {
1097 browser -
1098 blame {
1099         enable_option bare
1100
1101         disable_option multicommit
1102         disable_option branch
1103         disable_option transport
1104 }
1105 citool {
1106         enable_option singlecommit
1107         enable_option retcode
1108
1109         disable_option multicommit
1110         disable_option branch
1111         disable_option transport
1112
1113         while {[llength $argv] > 0} {
1114                 set a [lindex $argv 0]
1115                 switch -- $a {
1116                 --amend {
1117                         enable_option initialamend
1118                 }
1119                 --nocommit {
1120                         enable_option nocommit
1121                         enable_option nocommitmsg
1122                 }
1123                 --commitmsg {
1124                         disable_option nocommitmsg
1125                 }
1126                 default {
1127                         break
1128                 }
1129                 }
1130
1131                 set argv [lrange $argv 1 end]
1132         }
1133 }
1134 }
1135
1136 ######################################################################
1137 ##
1138 ## execution environment
1139
1140 set have_tk85 [expr {[package vcompare $tk_version "8.5"] >= 0}]
1141
1142 # Suggest our implementation of askpass, if none is set
1143 if {![info exists env(SSH_ASKPASS)]} {
1144         set env(SSH_ASKPASS) [gitexec git-gui--askpass]
1145 }
1146
1147 ######################################################################
1148 ##
1149 ## repository setup
1150
1151 set picked 0
1152 if {[catch {
1153                 set _gitdir $env(GIT_DIR)
1154                 set _prefix {}
1155                 }]
1156         && [catch {
1157                 # beware that from the .git dir this sets _gitdir to .
1158                 # and _prefix to the empty string
1159                 set _gitdir [git rev-parse --git-dir]
1160                 set _prefix [git rev-parse --show-prefix]
1161         } err]} {
1162         load_config 1
1163         apply_config
1164         choose_repository::pick
1165         set picked 1
1166 }
1167
1168 # we expand the _gitdir when it's just a single dot (i.e. when we're being
1169 # run from the .git dir itself) lest the routines to find the worktree
1170 # get confused
1171 if {$_gitdir eq "."} {
1172         set _gitdir [pwd]
1173 }
1174
1175 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
1176         catch {set _gitdir [exec cygpath --windows $_gitdir]}
1177 }
1178 if {![file isdirectory $_gitdir]} {
1179         catch {wm withdraw .}
1180         error_popup [strcat [mc "Git directory not found:"] "\n\n$_gitdir"]
1181         exit 1
1182 }
1183 # _gitdir exists, so try loading the config
1184 load_config 0
1185 apply_config
1186 # try to set work tree from environment, falling back to core.worktree
1187 if {[catch { set _gitworktree $env(GIT_WORK_TREE) }]} {
1188         set _gitworktree [get_config core.worktree]
1189         if {$_gitworktree eq ""} {
1190                 set _gitworktree [file dirname [file normalize $_gitdir]]
1191         }
1192 }
1193 if {$_prefix ne {}} {
1194         if {$_gitworktree eq {}} {
1195                 regsub -all {[^/]+/} $_prefix ../ cdup
1196         } else {
1197                 set cdup $_gitworktree
1198         }
1199         if {[catch {cd $cdup} err]} {
1200                 catch {wm withdraw .}
1201                 error_popup [strcat [mc "Cannot move to top of working directory:"] "\n\n$err"]
1202                 exit 1
1203         }
1204         set _gitworktree [pwd]
1205         unset cdup
1206 } elseif {![is_enabled bare]} {
1207         if {[is_bare]} {
1208                 catch {wm withdraw .}
1209                 error_popup [strcat [mc "Cannot use bare repository:"] "\n\n$_gitdir"]
1210                 exit 1
1211         }
1212         if {$_gitworktree eq {}} {
1213                 set _gitworktree [file dirname $_gitdir]
1214         }
1215         if {[catch {cd $_gitworktree} err]} {
1216                 catch {wm withdraw .}
1217                 error_popup [strcat [mc "No working directory"] " $_gitworktree:\n\n$err"]
1218                 exit 1
1219         }
1220         set _gitworktree [pwd]
1221 }
1222 set _reponame [file split [file normalize $_gitdir]]
1223 if {[lindex $_reponame end] eq {.git}} {
1224         set _reponame [lindex $_reponame end-1]
1225 } else {
1226         set _reponame [lindex $_reponame end]
1227 }
1228
1229 set env(GIT_DIR) $_gitdir
1230 set env(GIT_WORK_TREE) $_gitworktree
1231
1232 ######################################################################
1233 ##
1234 ## global init
1235
1236 set current_diff_path {}
1237 set current_diff_side {}
1238 set diff_actions [list]
1239
1240 set HEAD {}
1241 set PARENT {}
1242 set MERGE_HEAD [list]
1243 set commit_type {}
1244 set empty_tree {}
1245 set current_branch {}
1246 set is_detached 0
1247 set current_diff_path {}
1248 set is_3way_diff 0
1249 set is_submodule_diff 0
1250 set is_conflict_diff 0
1251 set selected_commit_type new
1252 set diff_empty_count 0
1253
1254 set nullid "0000000000000000000000000000000000000000"
1255 set nullid2 "0000000000000000000000000000000000000001"
1256
1257 ######################################################################
1258 ##
1259 ## task management
1260
1261 set rescan_active 0
1262 set diff_active 0
1263 set last_clicked {}
1264
1265 set disable_on_lock [list]
1266 set index_lock_type none
1267
1268 proc lock_index {type} {
1269         global index_lock_type disable_on_lock
1270
1271         if {$index_lock_type eq {none}} {
1272                 set index_lock_type $type
1273                 foreach w $disable_on_lock {
1274                         uplevel #0 $w disabled
1275                 }
1276                 return 1
1277         } elseif {$index_lock_type eq "begin-$type"} {
1278                 set index_lock_type $type
1279                 return 1
1280         }
1281         return 0
1282 }
1283
1284 proc unlock_index {} {
1285         global index_lock_type disable_on_lock
1286
1287         set index_lock_type none
1288         foreach w $disable_on_lock {
1289                 uplevel #0 $w normal
1290         }
1291 }
1292
1293 ######################################################################
1294 ##
1295 ## status
1296
1297 proc repository_state {ctvar hdvar mhvar} {
1298         global current_branch
1299         upvar $ctvar ct $hdvar hd $mhvar mh
1300
1301         set mh [list]
1302
1303         load_current_branch
1304         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
1305                 set hd {}
1306                 set ct initial
1307                 return
1308         }
1309
1310         set merge_head [gitdir MERGE_HEAD]
1311         if {[file exists $merge_head]} {
1312                 set ct merge
1313                 set fd_mh [open $merge_head r]
1314                 while {[gets $fd_mh line] >= 0} {
1315                         lappend mh $line
1316                 }
1317                 close $fd_mh
1318                 return
1319         }
1320
1321         set ct normal
1322 }
1323
1324 proc PARENT {} {
1325         global PARENT empty_tree
1326
1327         set p [lindex $PARENT 0]
1328         if {$p ne {}} {
1329                 return $p
1330         }
1331         if {$empty_tree eq {}} {
1332                 set empty_tree [git mktree << {}]
1333         }
1334         return $empty_tree
1335 }
1336
1337 proc force_amend {} {
1338         global selected_commit_type
1339         global HEAD PARENT MERGE_HEAD commit_type
1340
1341         repository_state newType newHEAD newMERGE_HEAD
1342         set HEAD $newHEAD
1343         set PARENT $newHEAD
1344         set MERGE_HEAD $newMERGE_HEAD
1345         set commit_type $newType
1346
1347         set selected_commit_type amend
1348         do_select_commit_type
1349 }
1350
1351 proc rescan {after {honor_trustmtime 1}} {
1352         global HEAD PARENT MERGE_HEAD commit_type
1353         global ui_index ui_workdir ui_comm
1354         global rescan_active file_states
1355         global repo_config
1356
1357         if {$rescan_active > 0 || ![lock_index read]} return
1358
1359         repository_state newType newHEAD newMERGE_HEAD
1360         if {[string match amend* $commit_type]
1361                 && $newType eq {normal}
1362                 && $newHEAD eq $HEAD} {
1363         } else {
1364                 set HEAD $newHEAD
1365                 set PARENT $newHEAD
1366                 set MERGE_HEAD $newMERGE_HEAD
1367                 set commit_type $newType
1368         }
1369
1370         array unset file_states
1371
1372         if {!$::GITGUI_BCK_exists &&
1373                 (![$ui_comm edit modified]
1374                 || [string trim [$ui_comm get 0.0 end]] eq {})} {
1375                 if {[string match amend* $commit_type]} {
1376                 } elseif {[load_message GITGUI_MSG]} {
1377                 } elseif {[run_prepare_commit_msg_hook]} {
1378                 } elseif {[load_message MERGE_MSG]} {
1379                 } elseif {[load_message SQUASH_MSG]} {
1380                 }
1381                 $ui_comm edit reset
1382                 $ui_comm edit modified false
1383         }
1384
1385         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
1386                 rescan_stage2 {} $after
1387         } else {
1388                 set rescan_active 1
1389                 ui_status [mc "Refreshing file status..."]
1390                 set fd_rf [git_read update-index \
1391                         -q \
1392                         --unmerged \
1393                         --ignore-missing \
1394                         --refresh \
1395                         ]
1396                 fconfigure $fd_rf -blocking 0 -translation binary
1397                 fileevent $fd_rf readable \
1398                         [list rescan_stage2 $fd_rf $after]
1399         }
1400 }
1401
1402 if {[is_Cygwin]} {
1403         set is_git_info_exclude {}
1404         proc have_info_exclude {} {
1405                 global is_git_info_exclude
1406
1407                 if {$is_git_info_exclude eq {}} {
1408                         if {[catch {exec test -f [gitdir info exclude]}]} {
1409                                 set is_git_info_exclude 0
1410                         } else {
1411                                 set is_git_info_exclude 1
1412                         }
1413                 }
1414                 return $is_git_info_exclude
1415         }
1416 } else {
1417         proc have_info_exclude {} {
1418                 return [file readable [gitdir info exclude]]
1419         }
1420 }
1421
1422 proc rescan_stage2 {fd after} {
1423         global rescan_active buf_rdi buf_rdf buf_rlo
1424
1425         if {$fd ne {}} {
1426                 read $fd
1427                 if {![eof $fd]} return
1428                 close $fd
1429         }
1430
1431         set ls_others [list --exclude-per-directory=.gitignore]
1432         if {[have_info_exclude]} {
1433                 lappend ls_others "--exclude-from=[gitdir info exclude]"
1434         }
1435         set user_exclude [get_config core.excludesfile]
1436         if {$user_exclude ne {} && [file readable $user_exclude]} {
1437                 lappend ls_others "--exclude-from=$user_exclude"
1438         }
1439
1440         set buf_rdi {}
1441         set buf_rdf {}
1442         set buf_rlo {}
1443
1444         set rescan_active 3
1445         ui_status [mc "Scanning for modified files ..."]
1446         set fd_di [git_read diff-index --cached -z [PARENT]]
1447         set fd_df [git_read diff-files -z]
1448         set fd_lo [eval git_read ls-files --others -z $ls_others]
1449
1450         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
1451         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
1452         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
1453         fileevent $fd_di readable [list read_diff_index $fd_di $after]
1454         fileevent $fd_df readable [list read_diff_files $fd_df $after]
1455         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
1456 }
1457
1458 proc load_message {file} {
1459         global ui_comm
1460
1461         set f [gitdir $file]
1462         if {[file isfile $f]} {
1463                 if {[catch {set fd [open $f r]}]} {
1464                         return 0
1465                 }
1466                 fconfigure $fd -eofchar {}
1467                 set content [string trim [read $fd]]
1468                 close $fd
1469                 regsub -all -line {[ \r\t]+$} $content {} content
1470                 $ui_comm delete 0.0 end
1471                 $ui_comm insert end $content
1472                 return 1
1473         }
1474         return 0
1475 }
1476
1477 proc run_prepare_commit_msg_hook {} {
1478         global pch_error
1479
1480         # prepare-commit-msg requires PREPARE_COMMIT_MSG exist.  From git-gui
1481         # it will be .git/MERGE_MSG (merge), .git/SQUASH_MSG (squash), or an
1482         # empty file but existant file.
1483
1484         set fd_pcm [open [gitdir PREPARE_COMMIT_MSG] a]
1485
1486         if {[file isfile [gitdir MERGE_MSG]]} {
1487                 set pcm_source "merge"
1488                 set fd_mm [open [gitdir MERGE_MSG] r]
1489                 puts -nonewline $fd_pcm [read $fd_mm]
1490                 close $fd_mm
1491         } elseif {[file isfile [gitdir SQUASH_MSG]]} {
1492                 set pcm_source "squash"
1493                 set fd_sm [open [gitdir SQUASH_MSG] r]
1494                 puts -nonewline $fd_pcm [read $fd_sm]
1495                 close $fd_sm
1496         } else {
1497                 set pcm_source ""
1498         }
1499
1500         close $fd_pcm
1501
1502         set fd_ph [githook_read prepare-commit-msg \
1503                         [gitdir PREPARE_COMMIT_MSG] $pcm_source]
1504         if {$fd_ph eq {}} {
1505                 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1506                 return 0;
1507         }
1508
1509         ui_status [mc "Calling prepare-commit-msg hook..."]
1510         set pch_error {}
1511
1512         fconfigure $fd_ph -blocking 0 -translation binary -eofchar {}
1513         fileevent $fd_ph readable \
1514                 [list prepare_commit_msg_hook_wait $fd_ph]
1515
1516         return 1;
1517 }
1518
1519 proc prepare_commit_msg_hook_wait {fd_ph} {
1520         global pch_error
1521
1522         append pch_error [read $fd_ph]
1523         fconfigure $fd_ph -blocking 1
1524         if {[eof $fd_ph]} {
1525                 if {[catch {close $fd_ph}]} {
1526                         ui_status [mc "Commit declined by prepare-commit-msg hook."]
1527                         hook_failed_popup prepare-commit-msg $pch_error
1528                         catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1529                         exit 1
1530                 } else {
1531                         load_message PREPARE_COMMIT_MSG
1532                 }
1533                 set pch_error {}
1534                 catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1535                 return
1536         }
1537         fconfigure $fd_ph -blocking 0
1538         catch {file delete [gitdir PREPARE_COMMIT_MSG]}
1539 }
1540
1541 proc read_diff_index {fd after} {
1542         global buf_rdi
1543
1544         append buf_rdi [read $fd]
1545         set c 0
1546         set n [string length $buf_rdi]
1547         while {$c < $n} {
1548                 set z1 [string first "\0" $buf_rdi $c]
1549                 if {$z1 == -1} break
1550                 incr z1
1551                 set z2 [string first "\0" $buf_rdi $z1]
1552                 if {$z2 == -1} break
1553
1554                 incr c
1555                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
1556                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
1557                 merge_state \
1558                         [encoding convertfrom $p] \
1559                         [lindex $i 4]? \
1560                         [list [lindex $i 0] [lindex $i 2]] \
1561                         [list]
1562                 set c $z2
1563                 incr c
1564         }
1565         if {$c < $n} {
1566                 set buf_rdi [string range $buf_rdi $c end]
1567         } else {
1568                 set buf_rdi {}
1569         }
1570
1571         rescan_done $fd buf_rdi $after
1572 }
1573
1574 proc read_diff_files {fd after} {
1575         global buf_rdf
1576
1577         append buf_rdf [read $fd]
1578         set c 0
1579         set n [string length $buf_rdf]
1580         while {$c < $n} {
1581                 set z1 [string first "\0" $buf_rdf $c]
1582                 if {$z1 == -1} break
1583                 incr z1
1584                 set z2 [string first "\0" $buf_rdf $z1]
1585                 if {$z2 == -1} break
1586
1587                 incr c
1588                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
1589                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
1590                 merge_state \
1591                         [encoding convertfrom $p] \
1592                         ?[lindex $i 4] \
1593                         [list] \
1594                         [list [lindex $i 0] [lindex $i 2]]
1595                 set c $z2
1596                 incr c
1597         }
1598         if {$c < $n} {
1599                 set buf_rdf [string range $buf_rdf $c end]
1600         } else {
1601                 set buf_rdf {}
1602         }
1603
1604         rescan_done $fd buf_rdf $after
1605 }
1606
1607 proc read_ls_others {fd after} {
1608         global buf_rlo
1609
1610         append buf_rlo [read $fd]
1611         set pck [split $buf_rlo "\0"]
1612         set buf_rlo [lindex $pck end]
1613         foreach p [lrange $pck 0 end-1] {
1614                 set p [encoding convertfrom $p]
1615                 if {[string index $p end] eq {/}} {
1616                         set p [string range $p 0 end-1]
1617                 }
1618                 merge_state $p ?O
1619         }
1620         rescan_done $fd buf_rlo $after
1621 }
1622
1623 proc rescan_done {fd buf after} {
1624         global rescan_active current_diff_path
1625         global file_states repo_config
1626         upvar $buf to_clear
1627
1628         if {![eof $fd]} return
1629         set to_clear {}
1630         close $fd
1631         if {[incr rescan_active -1] > 0} return
1632
1633         prune_selection
1634         unlock_index
1635         display_all_files
1636         if {$current_diff_path ne {}} { reshow_diff $after }
1637         if {$current_diff_path eq {}} { select_first_diff $after }
1638 }
1639
1640 proc prune_selection {} {
1641         global file_states selected_paths
1642
1643         foreach path [array names selected_paths] {
1644                 if {[catch {set still_here $file_states($path)}]} {
1645                         unset selected_paths($path)
1646                 }
1647         }
1648 }
1649
1650 ######################################################################
1651 ##
1652 ## ui helpers
1653
1654 proc mapicon {w state path} {
1655         global all_icons
1656
1657         if {[catch {set r $all_icons($state$w)}]} {
1658                 puts "error: no icon for $w state={$state} $path"
1659                 return file_plain
1660         }
1661         return $r
1662 }
1663
1664 proc mapdesc {state path} {
1665         global all_descs
1666
1667         if {[catch {set r $all_descs($state)}]} {
1668                 puts "error: no desc for state={$state} $path"
1669                 return $state
1670         }
1671         return $r
1672 }
1673
1674 proc ui_status {msg} {
1675         global main_status
1676         if {[info exists main_status]} {
1677                 $main_status show $msg
1678         }
1679 }
1680
1681 proc ui_ready {{test {}}} {
1682         global main_status
1683         if {[info exists main_status]} {
1684                 $main_status show [mc "Ready."] $test
1685         }
1686 }
1687
1688 proc escape_path {path} {
1689         regsub -all {\\} $path "\\\\" path
1690         regsub -all "\n" $path "\\n" path
1691         return $path
1692 }
1693
1694 proc short_path {path} {
1695         return [escape_path [lindex [file split $path] end]]
1696 }
1697
1698 set next_icon_id 0
1699 set null_sha1 [string repeat 0 40]
1700
1701 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1702         global file_states next_icon_id null_sha1
1703
1704         set s0 [string index $new_state 0]
1705         set s1 [string index $new_state 1]
1706
1707         if {[catch {set info $file_states($path)}]} {
1708                 set state __
1709                 set icon n[incr next_icon_id]
1710         } else {
1711                 set state [lindex $info 0]
1712                 set icon [lindex $info 1]
1713                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1714                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1715         }
1716
1717         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1718         elseif {$s0 eq {_}} {set s0 _}
1719
1720         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1721         elseif {$s1 eq {_}} {set s1 _}
1722
1723         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1724                 set head_info [list 0 $null_sha1]
1725         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1726                 && $head_info eq {}} {
1727                 set head_info $index_info
1728         } elseif {$s0 eq {_} && [string index $state 0] ne {_}} {
1729                 set index_info $head_info
1730                 set head_info {}
1731         }
1732
1733         set file_states($path) [list $s0$s1 $icon \
1734                 $head_info $index_info \
1735                 ]
1736         return $state
1737 }
1738
1739 proc display_file_helper {w path icon_name old_m new_m} {
1740         global file_lists
1741
1742         if {$new_m eq {_}} {
1743                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1744                 if {$lno >= 0} {
1745                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1746                         incr lno
1747                         $w conf -state normal
1748                         $w delete $lno.0 [expr {$lno + 1}].0
1749                         $w conf -state disabled
1750                 }
1751         } elseif {$old_m eq {_} && $new_m ne {_}} {
1752                 lappend file_lists($w) $path
1753                 set file_lists($w) [lsort -unique $file_lists($w)]
1754                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1755                 incr lno
1756                 $w conf -state normal
1757                 $w image create $lno.0 \
1758                         -align center -padx 5 -pady 1 \
1759                         -name $icon_name \
1760                         -image [mapicon $w $new_m $path]
1761                 $w insert $lno.1 "[escape_path $path]\n"
1762                 $w conf -state disabled
1763         } elseif {$old_m ne $new_m} {
1764                 $w conf -state normal
1765                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1766                 $w conf -state disabled
1767         }
1768 }
1769
1770 proc display_file {path state} {
1771         global file_states selected_paths
1772         global ui_index ui_workdir
1773
1774         set old_m [merge_state $path $state]
1775         set s $file_states($path)
1776         set new_m [lindex $s 0]
1777         set icon_name [lindex $s 1]
1778
1779         set o [string index $old_m 0]
1780         set n [string index $new_m 0]
1781         if {$o eq {U}} {
1782                 set o _
1783         }
1784         if {$n eq {U}} {
1785                 set n _
1786         }
1787         display_file_helper     $ui_index $path $icon_name $o $n
1788
1789         if {[string index $old_m 0] eq {U}} {
1790                 set o U
1791         } else {
1792                 set o [string index $old_m 1]
1793         }
1794         if {[string index $new_m 0] eq {U}} {
1795                 set n U
1796         } else {
1797                 set n [string index $new_m 1]
1798         }
1799         display_file_helper     $ui_workdir $path $icon_name $o $n
1800
1801         if {$new_m eq {__}} {
1802                 unset file_states($path)
1803                 catch {unset selected_paths($path)}
1804         }
1805 }
1806
1807 proc display_all_files_helper {w path icon_name m} {
1808         global file_lists
1809
1810         lappend file_lists($w) $path
1811         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1812         $w image create end \
1813                 -align center -padx 5 -pady 1 \
1814                 -name $icon_name \
1815                 -image [mapicon $w $m $path]
1816         $w insert end "[escape_path $path]\n"
1817 }
1818
1819 set files_warning 0
1820 proc display_all_files {} {
1821         global ui_index ui_workdir
1822         global file_states file_lists
1823         global last_clicked
1824         global files_warning
1825
1826         $ui_index conf -state normal
1827         $ui_workdir conf -state normal
1828
1829         $ui_index delete 0.0 end
1830         $ui_workdir delete 0.0 end
1831         set last_clicked {}
1832
1833         set file_lists($ui_index) [list]
1834         set file_lists($ui_workdir) [list]
1835
1836         set to_display [lsort [array names file_states]]
1837         set display_limit [get_config gui.maxfilesdisplayed]
1838         if {[llength $to_display] > $display_limit} {
1839                 if {!$files_warning} {
1840                         # do not repeatedly warn:
1841                         set files_warning 1
1842                         info_popup [mc "Displaying only %s of %s files." \
1843                                 $display_limit [llength $to_display]]
1844                 }
1845                 set to_display [lrange $to_display 0 [expr {$display_limit-1}]]
1846         }
1847         foreach path $to_display {
1848                 set s $file_states($path)
1849                 set m [lindex $s 0]
1850                 set icon_name [lindex $s 1]
1851
1852                 set s [string index $m 0]
1853                 if {$s ne {U} && $s ne {_}} {
1854                         display_all_files_helper $ui_index $path \
1855                                 $icon_name $s
1856                 }
1857
1858                 if {[string index $m 0] eq {U}} {
1859                         set s U
1860                 } else {
1861                         set s [string index $m 1]
1862                 }
1863                 if {$s ne {_}} {
1864                         display_all_files_helper $ui_workdir $path \
1865                                 $icon_name $s
1866                 }
1867         }
1868
1869         $ui_index conf -state disabled
1870         $ui_workdir conf -state disabled
1871 }
1872
1873 ######################################################################
1874 ##
1875 ## icons
1876
1877 set filemask {
1878 #define mask_width 14
1879 #define mask_height 15
1880 static unsigned char mask_bits[] = {
1881    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1882    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1883    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1884 }
1885
1886 image create bitmap file_plain -background white -foreground black -data {
1887 #define plain_width 14
1888 #define plain_height 15
1889 static unsigned char plain_bits[] = {
1890    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1891    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1892    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1893 } -maskdata $filemask
1894
1895 image create bitmap file_mod -background white -foreground blue -data {
1896 #define mod_width 14
1897 #define mod_height 15
1898 static unsigned char mod_bits[] = {
1899    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1900    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1901    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1902 } -maskdata $filemask
1903
1904 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1905 #define file_fulltick_width 14
1906 #define file_fulltick_height 15
1907 static unsigned char file_fulltick_bits[] = {
1908    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1909    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1910    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1911 } -maskdata $filemask
1912
1913 image create bitmap file_question -background white -foreground black -data {
1914 #define file_question_width 14
1915 #define file_question_height 15
1916 static unsigned char file_question_bits[] = {
1917    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1918    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1919    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1920 } -maskdata $filemask
1921
1922 image create bitmap file_removed -background white -foreground red -data {
1923 #define file_removed_width 14
1924 #define file_removed_height 15
1925 static unsigned char file_removed_bits[] = {
1926    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1927    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1928    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1929 } -maskdata $filemask
1930
1931 image create bitmap file_merge -background white -foreground blue -data {
1932 #define file_merge_width 14
1933 #define file_merge_height 15
1934 static unsigned char file_merge_bits[] = {
1935    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1936    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1937    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1938 } -maskdata $filemask
1939
1940 image create bitmap file_statechange -background white -foreground green -data {
1941 #define file_merge_width 14
1942 #define file_merge_height 15
1943 static unsigned char file_statechange_bits[] = {
1944    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x62, 0x10,
1945    0x62, 0x10, 0xba, 0x11, 0xba, 0x11, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10,
1946    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1947 } -maskdata $filemask
1948
1949 set ui_index .vpane.files.index.list
1950 set ui_workdir .vpane.files.workdir.list
1951
1952 set all_icons(_$ui_index)   file_plain
1953 set all_icons(A$ui_index)   file_plain
1954 set all_icons(M$ui_index)   file_fulltick
1955 set all_icons(D$ui_index)   file_removed
1956 set all_icons(U$ui_index)   file_merge
1957 set all_icons(T$ui_index)   file_statechange
1958
1959 set all_icons(_$ui_workdir) file_plain
1960 set all_icons(M$ui_workdir) file_mod
1961 set all_icons(D$ui_workdir) file_question
1962 set all_icons(U$ui_workdir) file_merge
1963 set all_icons(O$ui_workdir) file_plain
1964 set all_icons(T$ui_workdir) file_statechange
1965
1966 set max_status_desc 0
1967 foreach i {
1968                 {__ {mc "Unmodified"}}
1969
1970                 {_M {mc "Modified, not staged"}}
1971                 {M_ {mc "Staged for commit"}}
1972                 {MM {mc "Portions staged for commit"}}
1973                 {MD {mc "Staged for commit, missing"}}
1974
1975                 {_T {mc "File type changed, not staged"}}
1976                 {T_ {mc "File type changed, staged"}}
1977
1978                 {_O {mc "Untracked, not staged"}}
1979                 {A_ {mc "Staged for commit"}}
1980                 {AM {mc "Portions staged for commit"}}
1981                 {AD {mc "Staged for commit, missing"}}
1982
1983                 {_D {mc "Missing"}}
1984                 {D_ {mc "Staged for removal"}}
1985                 {DO {mc "Staged for removal, still present"}}
1986
1987                 {_U {mc "Requires merge resolution"}}
1988                 {U_ {mc "Requires merge resolution"}}
1989                 {UU {mc "Requires merge resolution"}}
1990                 {UM {mc "Requires merge resolution"}}
1991                 {UD {mc "Requires merge resolution"}}
1992                 {UT {mc "Requires merge resolution"}}
1993         } {
1994         set text [eval [lindex $i 1]]
1995         if {$max_status_desc < [string length $text]} {
1996                 set max_status_desc [string length $text]
1997         }
1998         set all_descs([lindex $i 0]) $text
1999 }
2000 unset i
2001
2002 ######################################################################
2003 ##
2004 ## util
2005
2006 proc scrollbar2many {list mode args} {
2007         foreach w $list {eval $w $mode $args}
2008 }
2009
2010 proc many2scrollbar {list mode sb top bottom} {
2011         $sb set $top $bottom
2012         foreach w $list {$w $mode moveto $top}
2013 }
2014
2015 proc incr_font_size {font {amt 1}} {
2016         set sz [font configure $font -size]
2017         incr sz $amt
2018         font configure $font -size $sz
2019         font configure ${font}bold -size $sz
2020         font configure ${font}italic -size $sz
2021 }
2022
2023 ######################################################################
2024 ##
2025 ## ui commands
2026
2027 set starting_gitk_msg [mc "Starting gitk... please wait..."]
2028
2029 proc do_gitk {revs {is_submodule false}} {
2030         global current_diff_path file_states current_diff_side ui_index
2031         global _gitdir _gitworktree
2032
2033         # -- Always start gitk through whatever we were loaded with.  This
2034         #    lets us bypass using shell process on Windows systems.
2035         #
2036         set exe [_which gitk -script]
2037         set cmd [list [info nameofexecutable] $exe]
2038         if {$exe eq {}} {
2039                 error_popup [mc "Couldn't find gitk in PATH"]
2040         } else {
2041                 global env
2042
2043                 set pwd [pwd]
2044
2045                 if {!$is_submodule} {
2046                         if {![is_bare]} {
2047                                 cd $_gitworktree
2048                         }
2049                 } else {
2050                         cd $current_diff_path
2051                         if {$revs eq {--}} {
2052                                 set s $file_states($current_diff_path)
2053                                 set old_sha1 {}
2054                                 set new_sha1 {}
2055                                 switch -glob -- [lindex $s 0] {
2056                                 M_ { set old_sha1 [lindex [lindex $s 2] 1] }
2057                                 _M { set old_sha1 [lindex [lindex $s 3] 1] }
2058                                 MM {
2059                                         if {$current_diff_side eq $ui_index} {
2060                                                 set old_sha1 [lindex [lindex $s 2] 1]
2061                                                 set new_sha1 [lindex [lindex $s 3] 1]
2062                                         } else {
2063                                                 set old_sha1 [lindex [lindex $s 3] 1]
2064                                         }
2065                                 }
2066                                 }
2067                                 set revs $old_sha1...$new_sha1
2068                         }
2069                         # GIT_DIR and GIT_WORK_TREE for the submodule are not the ones
2070                         # we've been using for the main repository, so unset them.
2071                         # TODO we could make life easier (start up faster?) for gitk
2072                         # by setting these to the appropriate values to allow gitk
2073                         # to skip the heuristics to find their proper value
2074                         unset env(GIT_DIR)
2075                         unset env(GIT_WORK_TREE)
2076                 }
2077                 eval exec $cmd $revs "--" "--" &
2078
2079                 set env(GIT_DIR) $_gitdir
2080                 set env(GIT_WORK_TREE) $_gitworktree
2081                 cd $pwd
2082
2083                 ui_status $::starting_gitk_msg
2084                 after 10000 {
2085                         ui_ready $starting_gitk_msg
2086                 }
2087         }
2088 }
2089
2090 proc do_git_gui {} {
2091         global current_diff_path
2092
2093         # -- Always start git gui through whatever we were loaded with.  This
2094         #    lets us bypass using shell process on Windows systems.
2095         #
2096         set exe [list [_which git]]
2097         if {$exe eq {}} {
2098                 error_popup [mc "Couldn't find git gui in PATH"]
2099         } else {
2100                 global env
2101                 global _gitdir _gitworktree
2102
2103                 # see note in do_gitk about unsetting these vars when
2104                 # running tools in a submodule
2105                 unset env(GIT_DIR)
2106                 unset env(GIT_WORK_TREE)
2107
2108                 set pwd [pwd]
2109                 cd $current_diff_path
2110
2111                 eval exec $exe gui &
2112
2113                 set env(GIT_DIR) $_gitdir
2114                 set env(GIT_WORK_TREE) $_gitworktree
2115                 cd $pwd
2116
2117                 ui_status $::starting_gitk_msg
2118                 after 10000 {
2119                         ui_ready $starting_gitk_msg
2120                 }
2121         }
2122 }
2123
2124 proc do_explore {} {
2125         global _gitworktree
2126         set explorer {}
2127         if {[is_Cygwin] || [is_Windows]} {
2128                 set explorer "explorer.exe"
2129         } elseif {[is_MacOSX]} {
2130                 set explorer "open"
2131         } else {
2132                 # freedesktop.org-conforming system is our best shot
2133                 set explorer "xdg-open"
2134         }
2135         eval exec $explorer [list [file nativename $_gitworktree]] &
2136 }
2137
2138 set is_quitting 0
2139 set ret_code    1
2140
2141 proc terminate_me {win} {
2142         global ret_code
2143         if {$win ne {.}} return
2144         exit $ret_code
2145 }
2146
2147 proc do_quit {{rc {1}}} {
2148         global ui_comm is_quitting repo_config commit_type
2149         global GITGUI_BCK_exists GITGUI_BCK_i
2150         global ui_comm_spell
2151         global ret_code use_ttk
2152
2153         if {$is_quitting} return
2154         set is_quitting 1
2155
2156         if {[winfo exists $ui_comm]} {
2157                 # -- Stash our current commit buffer.
2158                 #
2159                 set save [gitdir GITGUI_MSG]
2160                 if {$GITGUI_BCK_exists && ![$ui_comm edit modified]} {
2161                         file rename -force [gitdir GITGUI_BCK] $save
2162                         set GITGUI_BCK_exists 0
2163                 } else {
2164                         set msg [string trim [$ui_comm get 0.0 end]]
2165                         regsub -all -line {[ \r\t]+$} $msg {} msg
2166                         if {(![string match amend* $commit_type]
2167                                 || [$ui_comm edit modified])
2168                                 && $msg ne {}} {
2169                                 catch {
2170                                         set fd [open $save w]
2171                                         puts -nonewline $fd $msg
2172                                         close $fd
2173                                 }
2174                         } else {
2175                                 catch {file delete $save}
2176                         }
2177                 }
2178
2179                 # -- Cancel our spellchecker if its running.
2180                 #
2181                 if {[info exists ui_comm_spell]} {
2182                         $ui_comm_spell stop
2183                 }
2184
2185                 # -- Remove our editor backup, its not needed.
2186                 #
2187                 after cancel $GITGUI_BCK_i
2188                 if {$GITGUI_BCK_exists} {
2189                         catch {file delete [gitdir GITGUI_BCK]}
2190                 }
2191
2192                 # -- Stash our current window geometry into this repository.
2193                 #
2194                 set cfg_wmstate [wm state .]
2195                 if {[catch {set rc_wmstate $repo_config(gui.wmstate)}]} {
2196                         set rc_wmstate {}
2197                 }
2198                 if {$cfg_wmstate ne $rc_wmstate} {
2199                         catch {git config gui.wmstate $cfg_wmstate}
2200                 }
2201                 if {$cfg_wmstate eq {zoomed}} {
2202                         # on Windows wm geometry will lie about window
2203                         # position (but not size) when window is zoomed
2204                         # restore the window before querying wm geometry
2205                         wm state . normal
2206                 }
2207                 set cfg_geometry [list]
2208                 lappend cfg_geometry [wm geometry .]
2209                 if {$use_ttk} {
2210                         lappend cfg_geometry [.vpane sashpos 0]
2211                         lappend cfg_geometry [.vpane.files sashpos 0]
2212                 } else {
2213                         lappend cfg_geometry [lindex [.vpane sash coord 0] 0]
2214                         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 1]
2215                 }
2216                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2217                         set rc_geometry {}
2218                 }
2219                 if {$cfg_geometry ne $rc_geometry} {
2220                         catch {git config gui.geometry $cfg_geometry}
2221                 }
2222         }
2223
2224         set ret_code $rc
2225
2226         # Briefly enable send again, working around Tk bug
2227         # http://sourceforge.net/tracker/?func=detail&atid=112997&aid=1821174&group_id=12997
2228         tk appname [appname]
2229
2230         destroy .
2231 }
2232
2233 proc do_rescan {} {
2234         rescan ui_ready
2235 }
2236
2237 proc ui_do_rescan {} {
2238         rescan {force_first_diff ui_ready}
2239 }
2240
2241 proc do_commit {} {
2242         commit_tree
2243 }
2244
2245 proc next_diff {{after {}}} {
2246         global next_diff_p next_diff_w next_diff_i
2247         show_diff $next_diff_p $next_diff_w {} {} $after
2248 }
2249
2250 proc find_anchor_pos {lst name} {
2251         set lid [lsearch -sorted -exact $lst $name]
2252
2253         if {$lid == -1} {
2254                 set lid 0
2255                 foreach lname $lst {
2256                         if {$lname >= $name} break
2257                         incr lid
2258                 }
2259         }
2260
2261         return $lid
2262 }
2263
2264 proc find_file_from {flist idx delta path mmask} {
2265         global file_states
2266
2267         set len [llength $flist]
2268         while {$idx >= 0 && $idx < $len} {
2269                 set name [lindex $flist $idx]
2270
2271                 if {$name ne $path && [info exists file_states($name)]} {
2272                         set state [lindex $file_states($name) 0]
2273
2274                         if {$mmask eq {} || [regexp $mmask $state]} {
2275                                 return $idx
2276                         }
2277                 }
2278
2279                 incr idx $delta
2280         }
2281
2282         return {}
2283 }
2284
2285 proc find_next_diff {w path {lno {}} {mmask {}}} {
2286         global next_diff_p next_diff_w next_diff_i
2287         global file_lists ui_index ui_workdir
2288
2289         set flist $file_lists($w)
2290         if {$lno eq {}} {
2291                 set lno [find_anchor_pos $flist $path]
2292         } else {
2293                 incr lno -1
2294         }
2295
2296         if {$mmask ne {} && ![regexp {(^\^)|(\$$)} $mmask]} {
2297                 if {$w eq $ui_index} {
2298                         set mmask "^$mmask"
2299                 } else {
2300                         set mmask "$mmask\$"
2301                 }
2302         }
2303
2304         set idx [find_file_from $flist $lno 1 $path $mmask]
2305         if {$idx eq {}} {
2306                 incr lno -1
2307                 set idx [find_file_from $flist $lno -1 $path $mmask]
2308         }
2309
2310         if {$idx ne {}} {
2311                 set next_diff_w $w
2312                 set next_diff_p [lindex $flist $idx]
2313                 set next_diff_i [expr {$idx+1}]
2314                 return 1
2315         } else {
2316                 return 0
2317         }
2318 }
2319
2320 proc next_diff_after_action {w path {lno {}} {mmask {}}} {
2321         global current_diff_path
2322
2323         if {$path ne $current_diff_path} {
2324                 return {}
2325         } elseif {[find_next_diff $w $path $lno $mmask]} {
2326                 return {next_diff;}
2327         } else {
2328                 return {reshow_diff;}
2329         }
2330 }
2331
2332 proc select_first_diff {after} {
2333         global ui_workdir
2334
2335         if {[find_next_diff $ui_workdir {} 1 {^_?U}] ||
2336             [find_next_diff $ui_workdir {} 1 {[^O]$}]} {
2337                 next_diff $after
2338         } else {
2339                 uplevel #0 $after
2340         }
2341 }
2342
2343 proc force_first_diff {after} {
2344         global ui_workdir current_diff_path file_states
2345
2346         if {[info exists file_states($current_diff_path)]} {
2347                 set state [lindex $file_states($current_diff_path) 0]
2348         } else {
2349                 set state {OO}
2350         }
2351
2352         set reselect 0
2353         if {[string first {U} $state] >= 0} {
2354                 # Already a conflict, do nothing
2355         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {^_?U}]} {
2356                 set reselect 1
2357         } elseif {[string index $state 1] ne {O}} {
2358                 # Already a diff & no conflicts, do nothing
2359         } elseif {[find_next_diff $ui_workdir $current_diff_path {} {[^O]$}]} {
2360                 set reselect 1
2361         }
2362
2363         if {$reselect} {
2364                 next_diff $after
2365         } else {
2366                 uplevel #0 $after
2367         }
2368 }
2369
2370 proc toggle_or_diff {w x y} {
2371         global file_states file_lists current_diff_path ui_index ui_workdir
2372         global last_clicked selected_paths
2373
2374         set pos [split [$w index @$x,$y] .]
2375         set lno [lindex $pos 0]
2376         set col [lindex $pos 1]
2377         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2378         if {$path eq {}} {
2379                 set last_clicked {}
2380                 return
2381         }
2382
2383         set last_clicked [list $w $lno]
2384         array unset selected_paths
2385         $ui_index tag remove in_sel 0.0 end
2386         $ui_workdir tag remove in_sel 0.0 end
2387
2388         # Determine the state of the file
2389         if {[info exists file_states($path)]} {
2390                 set state [lindex $file_states($path) 0]
2391         } else {
2392                 set state {__}
2393         }
2394
2395         # Restage the file, or simply show the diff
2396         if {$col == 0 && $y > 1} {
2397                 # Conflicts need special handling
2398                 if {[string first {U} $state] >= 0} {
2399                         # $w must always be $ui_workdir, but...
2400                         if {$w ne $ui_workdir} { set lno {} }
2401                         merge_stage_workdir $path $lno
2402                         return
2403                 }
2404
2405                 if {[string index $state 1] eq {O}} {
2406                         set mmask {}
2407                 } else {
2408                         set mmask {[^O]}
2409                 }
2410
2411                 set after [next_diff_after_action $w $path $lno $mmask]
2412
2413                 if {$w eq $ui_index} {
2414                         update_indexinfo \
2415                                 "Unstaging [short_path $path] from commit" \
2416                                 [list $path] \
2417                                 [concat $after [list ui_ready]]
2418                 } elseif {$w eq $ui_workdir} {
2419                         update_index \
2420                                 "Adding [short_path $path]" \
2421                                 [list $path] \
2422                                 [concat $after [list ui_ready]]
2423                 }
2424         } else {
2425                 show_diff $path $w $lno
2426         }
2427 }
2428
2429 proc add_one_to_selection {w x y} {
2430         global file_lists last_clicked selected_paths
2431
2432         set lno [lindex [split [$w index @$x,$y] .] 0]
2433         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2434         if {$path eq {}} {
2435                 set last_clicked {}
2436                 return
2437         }
2438
2439         if {$last_clicked ne {}
2440                 && [lindex $last_clicked 0] ne $w} {
2441                 array unset selected_paths
2442                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
2443         }
2444
2445         set last_clicked [list $w $lno]
2446         if {[catch {set in_sel $selected_paths($path)}]} {
2447                 set in_sel 0
2448         }
2449         if {$in_sel} {
2450                 unset selected_paths($path)
2451                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2452         } else {
2453                 set selected_paths($path) 1
2454                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2455         }
2456 }
2457
2458 proc add_range_to_selection {w x y} {
2459         global file_lists last_clicked selected_paths
2460
2461         if {[lindex $last_clicked 0] ne $w} {
2462                 toggle_or_diff $w $x $y
2463                 return
2464         }
2465
2466         set lno [lindex [split [$w index @$x,$y] .] 0]
2467         set lc [lindex $last_clicked 1]
2468         if {$lc < $lno} {
2469                 set begin $lc
2470                 set end $lno
2471         } else {
2472                 set begin $lno
2473                 set end $lc
2474         }
2475
2476         foreach path [lrange $file_lists($w) \
2477                 [expr {$begin - 1}] \
2478                 [expr {$end - 1}]] {
2479                 set selected_paths($path) 1
2480         }
2481         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2482 }
2483
2484 proc show_more_context {} {
2485         global repo_config
2486         if {$repo_config(gui.diffcontext) < 99} {
2487                 incr repo_config(gui.diffcontext)
2488                 reshow_diff
2489         }
2490 }
2491
2492 proc show_less_context {} {
2493         global repo_config
2494         if {$repo_config(gui.diffcontext) > 1} {
2495                 incr repo_config(gui.diffcontext) -1
2496                 reshow_diff
2497         }
2498 }
2499
2500 ######################################################################
2501 ##
2502 ## ui construction
2503
2504 set ui_comm {}
2505
2506 # -- Menu Bar
2507 #
2508 menu .mbar -tearoff 0
2509 if {[is_MacOSX]} {
2510         # -- Apple Menu (Mac OS X only)
2511         #
2512         .mbar add cascade -label Apple -menu .mbar.apple
2513         menu .mbar.apple
2514 }
2515 .mbar add cascade -label [mc Repository] -menu .mbar.repository
2516 .mbar add cascade -label [mc Edit] -menu .mbar.edit
2517 if {[is_enabled branch]} {
2518         .mbar add cascade -label [mc Branch] -menu .mbar.branch
2519 }
2520 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2521         .mbar add cascade -label [mc Commit@@noun] -menu .mbar.commit
2522 }
2523 if {[is_enabled transport]} {
2524         .mbar add cascade -label [mc Merge] -menu .mbar.merge
2525         .mbar add cascade -label [mc Remote] -menu .mbar.remote
2526 }
2527 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2528         .mbar add cascade -label [mc Tools] -menu .mbar.tools
2529 }
2530
2531 # -- Repository Menu
2532 #
2533 menu .mbar.repository
2534
2535 if {![is_bare]} {
2536         .mbar.repository add command \
2537                 -label [mc "Explore Working Copy"] \
2538                 -command {do_explore}
2539         .mbar.repository add separator
2540 }
2541
2542 .mbar.repository add command \
2543         -label [mc "Browse Current Branch's Files"] \
2544         -command {browser::new $current_branch}
2545 set ui_browse_current [.mbar.repository index last]
2546 .mbar.repository add command \
2547         -label [mc "Browse Branch Files..."] \
2548         -command browser_open::dialog
2549 .mbar.repository add separator
2550
2551 .mbar.repository add command \
2552         -label [mc "Visualize Current Branch's History"] \
2553         -command {do_gitk $current_branch}
2554 set ui_visualize_current [.mbar.repository index last]
2555 .mbar.repository add command \
2556         -label [mc "Visualize All Branch History"] \
2557         -command {do_gitk --all}
2558 .mbar.repository add separator
2559
2560 proc current_branch_write {args} {
2561         global current_branch
2562         .mbar.repository entryconf $::ui_browse_current \
2563                 -label [mc "Browse %s's Files" $current_branch]
2564         .mbar.repository entryconf $::ui_visualize_current \
2565                 -label [mc "Visualize %s's History" $current_branch]
2566 }
2567 trace add variable current_branch write current_branch_write
2568
2569 if {[is_enabled multicommit]} {
2570         .mbar.repository add command -label [mc "Database Statistics"] \
2571                 -command do_stats
2572
2573         .mbar.repository add command -label [mc "Compress Database"] \
2574                 -command do_gc
2575
2576         .mbar.repository add command -label [mc "Verify Database"] \
2577                 -command do_fsck_objects
2578
2579         .mbar.repository add separator
2580
2581         if {[is_Cygwin]} {
2582                 .mbar.repository add command \
2583                         -label [mc "Create Desktop Icon"] \
2584                         -command do_cygwin_shortcut
2585         } elseif {[is_Windows]} {
2586                 .mbar.repository add command \
2587                         -label [mc "Create Desktop Icon"] \
2588                         -command do_windows_shortcut
2589         } elseif {[is_MacOSX]} {
2590                 .mbar.repository add command \
2591                         -label [mc "Create Desktop Icon"] \
2592                         -command do_macosx_app
2593         }
2594 }
2595
2596 if {[is_MacOSX]} {
2597         proc ::tk::mac::Quit {args} { do_quit }
2598 } else {
2599         .mbar.repository add command -label [mc Quit] \
2600                 -command do_quit \
2601                 -accelerator $M1T-Q
2602 }
2603
2604 # -- Edit Menu
2605 #
2606 menu .mbar.edit
2607 .mbar.edit add command -label [mc Undo] \
2608         -command {catch {[focus] edit undo}} \
2609         -accelerator $M1T-Z
2610 .mbar.edit add command -label [mc Redo] \
2611         -command {catch {[focus] edit redo}} \
2612         -accelerator $M1T-Y
2613 .mbar.edit add separator
2614 .mbar.edit add command -label [mc Cut] \
2615         -command {catch {tk_textCut [focus]}} \
2616         -accelerator $M1T-X
2617 .mbar.edit add command -label [mc Copy] \
2618         -command {catch {tk_textCopy [focus]}} \
2619         -accelerator $M1T-C
2620 .mbar.edit add command -label [mc Paste] \
2621         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2622         -accelerator $M1T-V
2623 .mbar.edit add command -label [mc Delete] \
2624         -command {catch {[focus] delete sel.first sel.last}} \
2625         -accelerator Del
2626 .mbar.edit add separator
2627 .mbar.edit add command -label [mc "Select All"] \
2628         -command {catch {[focus] tag add sel 0.0 end}} \
2629         -accelerator $M1T-A
2630
2631 # -- Branch Menu
2632 #
2633 if {[is_enabled branch]} {
2634         menu .mbar.branch
2635
2636         .mbar.branch add command -label [mc "Create..."] \
2637                 -command branch_create::dialog \
2638                 -accelerator $M1T-N
2639         lappend disable_on_lock [list .mbar.branch entryconf \
2640                 [.mbar.branch index last] -state]
2641
2642         .mbar.branch add command -label [mc "Checkout..."] \
2643                 -command branch_checkout::dialog \
2644                 -accelerator $M1T-O
2645         lappend disable_on_lock [list .mbar.branch entryconf \
2646                 [.mbar.branch index last] -state]
2647
2648         .mbar.branch add command -label [mc "Rename..."] \
2649                 -command branch_rename::dialog
2650         lappend disable_on_lock [list .mbar.branch entryconf \
2651                 [.mbar.branch index last] -state]
2652
2653         .mbar.branch add command -label [mc "Delete..."] \
2654                 -command branch_delete::dialog
2655         lappend disable_on_lock [list .mbar.branch entryconf \
2656                 [.mbar.branch index last] -state]
2657
2658         .mbar.branch add command -label [mc "Reset..."] \
2659                 -command merge::reset_hard
2660         lappend disable_on_lock [list .mbar.branch entryconf \
2661                 [.mbar.branch index last] -state]
2662 }
2663
2664 # -- Commit Menu
2665 #
2666 proc commit_btn_caption {} {
2667         if {[is_enabled nocommit]} {
2668                 return [mc "Done"]
2669         } else {
2670                 return [mc Commit@@verb]
2671         }
2672 }
2673
2674 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2675         menu .mbar.commit
2676
2677         if {![is_enabled nocommit]} {
2678                 .mbar.commit add radiobutton \
2679                         -label [mc "New Commit"] \
2680                         -command do_select_commit_type \
2681                         -variable selected_commit_type \
2682                         -value new
2683                 lappend disable_on_lock \
2684                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2685
2686                 .mbar.commit add radiobutton \
2687                         -label [mc "Amend Last Commit"] \
2688                         -command do_select_commit_type \
2689                         -variable selected_commit_type \
2690                         -value amend
2691                 lappend disable_on_lock \
2692                         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2693
2694                 .mbar.commit add separator
2695         }
2696
2697         .mbar.commit add command -label [mc Rescan] \
2698                 -command ui_do_rescan \
2699                 -accelerator F5
2700         lappend disable_on_lock \
2701                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2702
2703         .mbar.commit add command -label [mc "Stage To Commit"] \
2704                 -command do_add_selection \
2705                 -accelerator $M1T-T
2706         lappend disable_on_lock \
2707                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2708
2709         .mbar.commit add command -label [mc "Stage Changed Files To Commit"] \
2710                 -command do_add_all \
2711                 -accelerator $M1T-I
2712         lappend disable_on_lock \
2713                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2714
2715         .mbar.commit add command -label [mc "Unstage From Commit"] \
2716                 -command do_unstage_selection \
2717                 -accelerator $M1T-U
2718         lappend disable_on_lock \
2719                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2720
2721         .mbar.commit add command -label [mc "Revert Changes"] \
2722                 -command do_revert_selection \
2723                 -accelerator $M1T-J
2724         lappend disable_on_lock \
2725                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2726
2727         .mbar.commit add separator
2728
2729         .mbar.commit add command -label [mc "Show Less Context"] \
2730                 -command show_less_context \
2731                 -accelerator $M1T-\-
2732
2733         .mbar.commit add command -label [mc "Show More Context"] \
2734                 -command show_more_context \
2735                 -accelerator $M1T-=
2736
2737         .mbar.commit add separator
2738
2739         if {![is_enabled nocommitmsg]} {
2740                 .mbar.commit add command -label [mc "Sign Off"] \
2741                         -command do_signoff \
2742                         -accelerator $M1T-S
2743         }
2744
2745         .mbar.commit add command -label [commit_btn_caption] \
2746                 -command do_commit \
2747                 -accelerator $M1T-Return
2748         lappend disable_on_lock \
2749                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2750 }
2751
2752 # -- Merge Menu
2753 #
2754 if {[is_enabled branch]} {
2755         menu .mbar.merge
2756         .mbar.merge add command -label [mc "Local Merge..."] \
2757                 -command merge::dialog \
2758                 -accelerator $M1T-M
2759         lappend disable_on_lock \
2760                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2761         .mbar.merge add command -label [mc "Abort Merge..."] \
2762                 -command merge::reset_hard
2763         lappend disable_on_lock \
2764                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
2765 }
2766
2767 # -- Transport Menu
2768 #
2769 if {[is_enabled transport]} {
2770         menu .mbar.remote
2771
2772         .mbar.remote add command \
2773                 -label [mc "Add..."] \
2774                 -command remote_add::dialog \
2775                 -accelerator $M1T-A
2776         .mbar.remote add command \
2777                 -label [mc "Push..."] \
2778                 -command do_push_anywhere \
2779                 -accelerator $M1T-P
2780         .mbar.remote add command \
2781                 -label [mc "Delete Branch..."] \
2782                 -command remote_branch_delete::dialog
2783 }
2784
2785 if {[is_MacOSX]} {
2786         proc ::tk::mac::ShowPreferences {} {do_options}
2787 } else {
2788         # -- Edit Menu
2789         #
2790         .mbar.edit add separator
2791         .mbar.edit add command -label [mc "Options..."] \
2792                 -command do_options
2793 }
2794
2795 # -- Tools Menu
2796 #
2797 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
2798         set tools_menubar .mbar.tools
2799         menu $tools_menubar
2800         $tools_menubar add separator
2801         $tools_menubar add command -label [mc "Add..."] -command tools_add::dialog
2802         $tools_menubar add command -label [mc "Remove..."] -command tools_remove::dialog
2803         set tools_tailcnt 3
2804         if {[array names repo_config guitool.*.cmd] ne {}} {
2805                 tools_populate_all
2806         }
2807 }
2808
2809 # -- Help Menu
2810 #
2811 .mbar add cascade -label [mc Help] -menu .mbar.help
2812 menu .mbar.help
2813
2814 if {[is_MacOSX]} {
2815         .mbar.apple add command -label [mc "About %s" [appname]] \
2816                 -command do_about
2817         .mbar.apple add separator
2818 } else {
2819         .mbar.help add command -label [mc "About %s" [appname]] \
2820                 -command do_about
2821 }
2822 . configure -menu .mbar
2823
2824 set doc_path [githtmldir]
2825 if {$doc_path ne {}} {
2826         set doc_path [file join $doc_path index.html]
2827
2828         if {[is_Cygwin]} {
2829                 set doc_path [exec cygpath --mixed $doc_path]
2830         }
2831 }
2832
2833 if {[file isfile $doc_path]} {
2834         set doc_url "file:$doc_path"
2835 } else {
2836         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
2837 }
2838
2839 proc start_browser {url} {
2840         git "web--browse" $url
2841 }
2842
2843 .mbar.help add command -label [mc "Online Documentation"] \
2844         -command [list start_browser $doc_url]
2845
2846 .mbar.help add command -label [mc "Show SSH Key"] \
2847         -command do_ssh_key
2848
2849 unset doc_path doc_url
2850
2851 # -- Standard bindings
2852 #
2853 wm protocol . WM_DELETE_WINDOW do_quit
2854 bind all <$M1B-Key-q> do_quit
2855 bind all <$M1B-Key-Q> do_quit
2856 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2857 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2858
2859 set subcommand_args {}
2860 proc usage {} {
2861         set s "usage: $::argv0 $::subcommand $::subcommand_args"
2862         if {[tk windowingsystem] eq "win32"} {
2863                 wm withdraw .
2864                 tk_messageBox -icon info -title "Usage" -message $s
2865         } else {
2866                 puts stderr $s
2867         }
2868         exit 1
2869 }
2870
2871 proc normalize_relpath {path} {
2872         set elements {}
2873         foreach item [file split $path] {
2874                 if {$item eq {.}} continue
2875                 if {$item eq {..} && [llength $elements] > 0
2876                     && [lindex $elements end] ne {..}} {
2877                         set elements [lrange $elements 0 end-1]
2878                         continue
2879                 }
2880                 lappend elements $item
2881         }
2882         return [eval file join $elements]
2883 }
2884
2885 # -- Not a normal commit type invocation?  Do that instead!
2886 #
2887 switch -- $subcommand {
2888 browser -
2889 blame {
2890         if {$subcommand eq "blame"} {
2891                 set subcommand_args {[--line=<num>] rev? path}
2892         } else {
2893                 set subcommand_args {rev? path}
2894         }
2895         if {$argv eq {}} usage
2896         set head {}
2897         set path {}
2898         set jump_spec {}
2899         set is_path 0
2900         foreach a $argv {
2901                 if {$is_path || [file exists $_prefix$a]} {
2902                         if {$path ne {}} usage
2903                         set path [normalize_relpath $_prefix$a]
2904                         break
2905                 } elseif {$a eq {--}} {
2906                         if {$path ne {}} {
2907                                 if {$head ne {}} usage
2908                                 set head $path
2909                                 set path {}
2910                         }
2911                         set is_path 1
2912                 } elseif {[regexp {^--line=(\d+)$} $a a lnum]} {
2913                         if {$jump_spec ne {} || $head ne {}} usage
2914                         set jump_spec [list $lnum]
2915                 } elseif {$head eq {}} {
2916                         if {$head ne {}} usage
2917                         set head $a
2918                         set is_path 1
2919                 } else {
2920                         usage
2921                 }
2922         }
2923         unset is_path
2924
2925         if {$head ne {} && $path eq {}} {
2926                 set path [normalize_relpath $_prefix$head]
2927                 set head {}
2928         }
2929
2930         if {$head eq {}} {
2931                 load_current_branch
2932         } else {
2933                 if {[regexp {^[0-9a-f]{1,39}$} $head]} {
2934                         if {[catch {
2935                                         set head [git rev-parse --verify $head]
2936                                 } err]} {
2937                                 puts stderr $err
2938                                 exit 1
2939                         }
2940                 }
2941                 set current_branch $head
2942         }
2943
2944         wm deiconify .
2945         switch -- $subcommand {
2946         browser {
2947                 if {$jump_spec ne {}} usage
2948                 if {$head eq {}} {
2949                         if {$path ne {} && [file isdirectory $path]} {
2950                                 set head $current_branch
2951                         } else {
2952                                 set head $path
2953                                 set path {}
2954                         }
2955                 }
2956                 browser::new $head $path
2957         }
2958         blame   {
2959                 if {$head eq {} && ![file exists $path]} {
2960                         catch {wm withdraw .}
2961                         tk_messageBox \
2962                                 -icon error \
2963                                 -type ok \
2964                                 -title [mc "git-gui: fatal error"] \
2965                                 -message [mc "fatal: cannot stat path %s: No such file or directory" $path]
2966                         exit 1
2967                 }
2968                 blame::new $head $path $jump_spec
2969         }
2970         }
2971         return
2972 }
2973 citool -
2974 gui {
2975         if {[llength $argv] != 0} {
2976                 puts -nonewline stderr "usage: $argv0"
2977                 if {$subcommand ne {gui}
2978                         && [file tail $argv0] ne "git-$subcommand"} {
2979                         puts -nonewline stderr " $subcommand"
2980                 }
2981                 puts stderr {}
2982                 exit 1
2983         }
2984         # fall through to setup UI for commits
2985 }
2986 default {
2987         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
2988         exit 1
2989 }
2990 }
2991
2992 # -- Branch Control
2993 #
2994 ${NS}::frame .branch
2995 if {!$use_ttk} {.branch configure -borderwidth 1 -relief sunken}
2996 ${NS}::label .branch.l1 \
2997         -text [mc "Current Branch:"] \
2998         -anchor w \
2999         -justify left
3000 ${NS}::label .branch.cb \
3001         -textvariable current_branch \
3002         -anchor w \
3003         -justify left
3004 pack .branch.l1 -side left
3005 pack .branch.cb -side left -fill x
3006 pack .branch -side top -fill x
3007
3008 # -- Main Window Layout
3009 #
3010 ${NS}::panedwindow .vpane -orient horizontal
3011 ${NS}::panedwindow .vpane.files -orient vertical
3012 if {$use_ttk} {
3013         .vpane add .vpane.files
3014 } else {
3015         .vpane add .vpane.files -sticky nsew -height 100 -width 200
3016 }
3017 pack .vpane -anchor n -side top -fill both -expand 1
3018
3019 # -- Index File List
3020 #
3021 ${NS}::frame .vpane.files.index -height 100 -width 200
3022 tlabel .vpane.files.index.title \
3023         -text [mc "Staged Changes (Will Commit)"] \
3024         -background lightgreen -foreground black
3025 text $ui_index -background white -foreground black \
3026         -borderwidth 0 \
3027         -width 20 -height 10 \
3028         -wrap none \
3029         -cursor $cursor_ptr \
3030         -xscrollcommand {.vpane.files.index.sx set} \
3031         -yscrollcommand {.vpane.files.index.sy set} \
3032         -state disabled
3033 ${NS}::scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
3034 ${NS}::scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
3035 pack .vpane.files.index.title -side top -fill x
3036 pack .vpane.files.index.sx -side bottom -fill x
3037 pack .vpane.files.index.sy -side right -fill y
3038 pack $ui_index -side left -fill both -expand 1
3039
3040 # -- Working Directory File List
3041 #
3042 ${NS}::frame .vpane.files.workdir -height 100 -width 200
3043 tlabel .vpane.files.workdir.title -text [mc "Unstaged Changes"] \
3044         -background lightsalmon -foreground black
3045 text $ui_workdir -background white -foreground black \
3046         -borderwidth 0 \
3047         -width 20 -height 10 \
3048         -wrap none \
3049         -cursor $cursor_ptr \
3050         -xscrollcommand {.vpane.files.workdir.sx set} \
3051         -yscrollcommand {.vpane.files.workdir.sy set} \
3052         -state disabled
3053 ${NS}::scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
3054 ${NS}::scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
3055 pack .vpane.files.workdir.title -side top -fill x
3056 pack .vpane.files.workdir.sx -side bottom -fill x
3057 pack .vpane.files.workdir.sy -side right -fill y
3058 pack $ui_workdir -side left -fill both -expand 1
3059
3060 .vpane.files add .vpane.files.workdir
3061 .vpane.files add .vpane.files.index
3062 if {!$use_ttk} {
3063         .vpane.files paneconfigure .vpane.files.workdir -sticky news
3064         .vpane.files paneconfigure .vpane.files.index -sticky news
3065 }
3066
3067 foreach i [list $ui_index $ui_workdir] {
3068         rmsel_tag $i
3069         $i tag conf in_diff -background [$i tag cget in_sel -background]
3070 }
3071 unset i
3072
3073 # -- Diff and Commit Area
3074 #
3075 ${NS}::frame .vpane.lower -height 300 -width 400
3076 ${NS}::frame .vpane.lower.commarea
3077 ${NS}::frame .vpane.lower.diff -relief sunken -borderwidth 1
3078 pack .vpane.lower.diff -fill both -expand 1
3079 pack .vpane.lower.commarea -side bottom -fill x
3080 .vpane add .vpane.lower
3081 if {!$use_ttk} {.vpane paneconfigure .vpane.lower -sticky nsew}
3082
3083 # -- Commit Area Buttons
3084 #
3085 ${NS}::frame .vpane.lower.commarea.buttons
3086 ${NS}::label .vpane.lower.commarea.buttons.l -text {} \
3087         -anchor w \
3088         -justify left
3089 pack .vpane.lower.commarea.buttons.l -side top -fill x
3090 pack .vpane.lower.commarea.buttons -side left -fill y
3091
3092 ${NS}::button .vpane.lower.commarea.buttons.rescan -text [mc Rescan] \
3093         -command ui_do_rescan
3094 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3095 lappend disable_on_lock \
3096         {.vpane.lower.commarea.buttons.rescan conf -state}
3097
3098 ${NS}::button .vpane.lower.commarea.buttons.incall -text [mc "Stage Changed"] \
3099         -command do_add_all
3100 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3101 lappend disable_on_lock \
3102         {.vpane.lower.commarea.buttons.incall conf -state}
3103
3104 if {![is_enabled nocommitmsg]} {
3105         ${NS}::button .vpane.lower.commarea.buttons.signoff -text [mc "Sign Off"] \
3106                 -command do_signoff
3107         pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3108 }
3109
3110 ${NS}::button .vpane.lower.commarea.buttons.commit -text [commit_btn_caption] \
3111         -command do_commit
3112 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3113 lappend disable_on_lock \
3114         {.vpane.lower.commarea.buttons.commit conf -state}
3115
3116 if {![is_enabled nocommit]} {
3117         ${NS}::button .vpane.lower.commarea.buttons.push -text [mc Push] \
3118                 -command do_push_anywhere
3119         pack .vpane.lower.commarea.buttons.push -side top -fill x
3120 }
3121
3122 # -- Commit Message Buffer
3123 #
3124 ${NS}::frame .vpane.lower.commarea.buffer
3125 ${NS}::frame .vpane.lower.commarea.buffer.header
3126 set ui_comm .vpane.lower.commarea.buffer.t
3127 set ui_coml .vpane.lower.commarea.buffer.header.l
3128
3129 if {![is_enabled nocommit]} {
3130         ${NS}::radiobutton .vpane.lower.commarea.buffer.header.new \
3131                 -text [mc "New Commit"] \
3132                 -command do_select_commit_type \
3133                 -variable selected_commit_type \
3134                 -value new
3135         lappend disable_on_lock \
3136                 [list .vpane.lower.commarea.buffer.header.new conf -state]
3137         ${NS}::radiobutton .vpane.lower.commarea.buffer.header.amend \
3138                 -text [mc "Amend Last Commit"] \
3139                 -command do_select_commit_type \
3140                 -variable selected_commit_type \
3141                 -value amend
3142         lappend disable_on_lock \
3143                 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3144 }
3145
3146 ${NS}::label $ui_coml \
3147         -anchor w \
3148         -justify left
3149 proc trace_commit_type {varname args} {
3150         global ui_coml commit_type
3151         switch -glob -- $commit_type {
3152         initial       {set txt [mc "Initial Commit Message:"]}
3153         amend         {set txt [mc "Amended Commit Message:"]}
3154         amend-initial {set txt [mc "Amended Initial Commit Message:"]}
3155         amend-merge   {set txt [mc "Amended Merge Commit Message:"]}
3156         merge         {set txt [mc "Merge Commit Message:"]}
3157         *             {set txt [mc "Commit Message:"]}
3158         }
3159         $ui_coml conf -text $txt
3160 }
3161 trace add variable commit_type write trace_commit_type
3162 pack $ui_coml -side left -fill x
3163
3164 if {![is_enabled nocommit]} {
3165         pack .vpane.lower.commarea.buffer.header.amend -side right
3166         pack .vpane.lower.commarea.buffer.header.new -side right
3167 }
3168
3169 text $ui_comm -background white -foreground black \
3170         -borderwidth 1 \
3171         -undo true \
3172         -maxundo 20 \
3173         -autoseparators true \
3174         -relief sunken \
3175         -width $repo_config(gui.commitmsgwidth) -height 9 -wrap none \
3176         -font font_diff \
3177         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3178 ${NS}::scrollbar .vpane.lower.commarea.buffer.sby \
3179         -command [list $ui_comm yview]
3180 pack .vpane.lower.commarea.buffer.header -side top -fill x
3181 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3182 pack $ui_comm -side left -fill y
3183 pack .vpane.lower.commarea.buffer -side left -fill y
3184
3185 # -- Commit Message Buffer Context Menu
3186 #
3187 set ctxm .vpane.lower.commarea.buffer.ctxm
3188 menu $ctxm -tearoff 0
3189 $ctxm add command \
3190         -label [mc Cut] \
3191         -command {tk_textCut $ui_comm}
3192 $ctxm add command \
3193         -label [mc Copy] \
3194         -command {tk_textCopy $ui_comm}
3195 $ctxm add command \
3196         -label [mc Paste] \
3197         -command {tk_textPaste $ui_comm}
3198 $ctxm add command \
3199         -label [mc Delete] \
3200         -command {catch {$ui_comm delete sel.first sel.last}}
3201 $ctxm add separator
3202 $ctxm add command \
3203         -label [mc "Select All"] \
3204         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
3205 $ctxm add command \
3206         -label [mc "Copy All"] \
3207         -command {
3208                 $ui_comm tag add sel 0.0 end
3209                 tk_textCopy $ui_comm
3210                 $ui_comm tag remove sel 0.0 end
3211         }
3212 $ctxm add separator
3213 $ctxm add command \
3214         -label [mc "Sign Off"] \
3215         -command do_signoff
3216 set ui_comm_ctxm $ctxm
3217
3218 # -- Diff Header
3219 #
3220 proc trace_current_diff_path {varname args} {
3221         global current_diff_path diff_actions file_states
3222         if {$current_diff_path eq {}} {
3223                 set s {}
3224                 set f {}
3225                 set p {}
3226                 set o disabled
3227         } else {
3228                 set p $current_diff_path
3229                 set s [mapdesc [lindex $file_states($p) 0] $p]
3230                 set f [mc "File:"]
3231                 set p [escape_path $p]
3232                 set o normal
3233         }
3234
3235         .vpane.lower.diff.header.status configure -text $s
3236         .vpane.lower.diff.header.file configure -text $f
3237         .vpane.lower.diff.header.path configure -text $p
3238         foreach w $diff_actions {
3239                 uplevel #0 $w $o
3240         }
3241 }
3242 trace add variable current_diff_path write trace_current_diff_path
3243
3244 gold_frame .vpane.lower.diff.header
3245 tlabel .vpane.lower.diff.header.status \
3246         -background gold \
3247         -foreground black \
3248         -width $max_status_desc \
3249         -anchor w \
3250         -justify left
3251 tlabel .vpane.lower.diff.header.file \
3252         -background gold \
3253         -foreground black \
3254         -anchor w \
3255         -justify left
3256 tlabel .vpane.lower.diff.header.path \
3257         -background gold \
3258         -foreground black \
3259         -anchor w \
3260         -justify left
3261 pack .vpane.lower.diff.header.status -side left
3262 pack .vpane.lower.diff.header.file -side left
3263 pack .vpane.lower.diff.header.path -fill x
3264 set ctxm .vpane.lower.diff.header.ctxm
3265 menu $ctxm -tearoff 0
3266 $ctxm add command \
3267         -label [mc Copy] \
3268         -command {
3269                 clipboard clear
3270                 clipboard append \
3271                         -format STRING \
3272                         -type STRING \
3273                         -- $current_diff_path
3274         }
3275 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3276 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3277
3278 # -- Diff Body
3279 #
3280 ${NS}::frame .vpane.lower.diff.body
3281 set ui_diff .vpane.lower.diff.body.t
3282 text $ui_diff -background white -foreground black \
3283         -borderwidth 0 \
3284         -width 80 -height 5 -wrap none \
3285         -font font_diff \
3286         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3287         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3288         -state disabled
3289 ${NS}::scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3290         -command [list $ui_diff xview]
3291 ${NS}::scrollbar .vpane.lower.diff.body.sby -orient vertical \
3292         -command [list $ui_diff yview]
3293 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3294 pack .vpane.lower.diff.body.sby -side right -fill y
3295 pack $ui_diff -side left -fill both -expand 1
3296 pack .vpane.lower.diff.header -side top -fill x
3297 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3298
3299 $ui_diff tag conf d_cr -elide true
3300 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
3301 $ui_diff tag conf d_+ -foreground {#00a000}
3302 $ui_diff tag conf d_- -foreground red
3303
3304 $ui_diff tag conf d_++ -foreground {#00a000}
3305 $ui_diff tag conf d_-- -foreground red
3306 $ui_diff tag conf d_+s \
3307         -foreground {#00a000} \
3308         -background {#e2effa}
3309 $ui_diff tag conf d_-s \
3310         -foreground red \
3311         -background {#e2effa}
3312 $ui_diff tag conf d_s+ \
3313         -foreground {#00a000} \
3314         -background ivory1
3315 $ui_diff tag conf d_s- \
3316         -foreground red \
3317         -background ivory1
3318
3319 $ui_diff tag conf d<<<<<<< \
3320         -foreground orange \
3321         -font font_diffbold
3322 $ui_diff tag conf d======= \
3323         -foreground orange \
3324         -font font_diffbold
3325 $ui_diff tag conf d>>>>>>> \
3326         -foreground orange \
3327         -font font_diffbold
3328
3329 $ui_diff tag raise sel
3330
3331 # -- Diff Body Context Menu
3332 #
3333
3334 proc create_common_diff_popup {ctxm} {
3335         $ctxm add command \
3336                 -label [mc Refresh] \
3337                 -command reshow_diff
3338         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3339         $ctxm add command \
3340                 -label [mc Copy] \
3341                 -command {tk_textCopy $ui_diff}
3342         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3343         $ctxm add command \
3344                 -label [mc "Select All"] \
3345                 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
3346         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3347         $ctxm add command \
3348                 -label [mc "Copy All"] \
3349                 -command {
3350                         $ui_diff tag add sel 0.0 end
3351                         tk_textCopy $ui_diff
3352                         $ui_diff tag remove sel 0.0 end
3353                 }
3354         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3355         $ctxm add separator
3356         $ctxm add command \
3357                 -label [mc "Decrease Font Size"] \
3358                 -command {incr_font_size font_diff -1}
3359         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3360         $ctxm add command \
3361                 -label [mc "Increase Font Size"] \
3362                 -command {incr_font_size font_diff 1}
3363         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3364         $ctxm add separator
3365         set emenu $ctxm.enc
3366         menu $emenu
3367         build_encoding_menu $emenu [list force_diff_encoding]
3368         $ctxm add cascade \
3369                 -label [mc "Encoding"] \
3370                 -menu $emenu
3371         lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3372         $ctxm add separator
3373         $ctxm add command -label [mc "Options..."] \
3374                 -command do_options
3375 }
3376
3377 set ctxm .vpane.lower.diff.body.ctxm
3378 menu $ctxm -tearoff 0
3379 $ctxm add command \
3380         -label [mc "Apply/Reverse Hunk"] \
3381         -command {apply_hunk $cursorX $cursorY}
3382 set ui_diff_applyhunk [$ctxm index last]
3383 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
3384 $ctxm add command \
3385         -label [mc "Apply/Reverse Line"] \
3386         -command {apply_range_or_line $cursorX $cursorY; do_rescan}
3387 set ui_diff_applyline [$ctxm index last]
3388 lappend diff_actions [list $ctxm entryconf $ui_diff_applyline -state]
3389 $ctxm add separator
3390 $ctxm add command \
3391         -label [mc "Show Less Context"] \
3392         -command show_less_context
3393 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3394 $ctxm add command \
3395         -label [mc "Show More Context"] \
3396         -command show_more_context
3397 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3398 $ctxm add separator
3399 create_common_diff_popup $ctxm
3400
3401 set ctxmmg .vpane.lower.diff.body.ctxmmg
3402 menu $ctxmmg -tearoff 0
3403 $ctxmmg add command \
3404         -label [mc "Run Merge Tool"] \
3405         -command {merge_resolve_tool}
3406 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3407 $ctxmmg add separator
3408 $ctxmmg add command \
3409         -label [mc "Use Remote Version"] \
3410         -command {merge_resolve_one 3}
3411 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3412 $ctxmmg add command \
3413         -label [mc "Use Local Version"] \
3414         -command {merge_resolve_one 2}
3415 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3416 $ctxmmg add command \
3417         -label [mc "Revert To Base"] \
3418         -command {merge_resolve_one 1}
3419 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3420 $ctxmmg add separator
3421 $ctxmmg add command \
3422         -label [mc "Show Less Context"] \
3423         -command show_less_context
3424 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3425 $ctxmmg add command \
3426         -label [mc "Show More Context"] \
3427         -command show_more_context
3428 lappend diff_actions [list $ctxmmg entryconf [$ctxmmg index last] -state]
3429 $ctxmmg add separator
3430 create_common_diff_popup $ctxmmg
3431
3432 set ctxmsm .vpane.lower.diff.body.ctxmsm
3433 menu $ctxmsm -tearoff 0
3434 $ctxmsm add command \
3435         -label [mc "Visualize These Changes In The Submodule"] \
3436         -command {do_gitk -- true}
3437 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3438 $ctxmsm add command \
3439         -label [mc "Visualize Current Branch History In The Submodule"] \
3440         -command {do_gitk {} true}
3441 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3442 $ctxmsm add command \
3443         -label [mc "Visualize All Branch History In The Submodule"] \
3444         -command {do_gitk --all true}
3445 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3446 $ctxmsm add separator
3447 $ctxmsm add command \
3448         -label [mc "Start git gui In The Submodule"] \
3449         -command {do_git_gui}
3450 lappend diff_actions [list $ctxmsm entryconf [$ctxmsm index last] -state]
3451 $ctxmsm add separator
3452 create_common_diff_popup $ctxmsm
3453
3454 proc has_textconv {path} {
3455         if {[is_config_false gui.textconv]} {
3456                 return 0
3457         }
3458         set filter [gitattr $path diff set]
3459         set textconv [get_config [join [list diff $filter textconv] .]]
3460         if {$filter ne {set} && $textconv ne {}} {
3461                 return 1
3462         } else {
3463                 return 0
3464         }
3465 }
3466
3467 proc popup_diff_menu {ctxm ctxmmg ctxmsm x y X Y} {
3468         global current_diff_path file_states
3469         set ::cursorX $x
3470         set ::cursorY $y
3471         if {[info exists file_states($current_diff_path)]} {
3472                 set state [lindex $file_states($current_diff_path) 0]
3473         } else {
3474                 set state {__}
3475         }
3476         if {[string first {U} $state] >= 0} {
3477                 tk_popup $ctxmmg $X $Y
3478         } elseif {$::is_submodule_diff} {
3479                 tk_popup $ctxmsm $X $Y
3480         } else {
3481                 set has_range [expr {[$::ui_diff tag nextrange sel 0.0] != {}}]
3482                 if {$::ui_index eq $::current_diff_side} {
3483                         set l [mc "Unstage Hunk From Commit"]
3484                         if {$has_range} {
3485                                 set t [mc "Unstage Lines From Commit"]
3486                         } else {
3487                                 set t [mc "Unstage Line From Commit"]
3488                         }
3489                 } else {
3490                         set l [mc "Stage Hunk For Commit"]
3491                         if {$has_range} {
3492                                 set t [mc "Stage Lines For Commit"]
3493                         } else {
3494                                 set t [mc "Stage Line For Commit"]
3495                         }
3496                 }
3497                 if {$::is_3way_diff
3498                         || $current_diff_path eq {}
3499                         || {__} eq $state
3500                         || {_O} eq $state
3501                         || {_T} eq $state
3502                         || {T_} eq $state
3503                         || [has_textconv $current_diff_path]} {
3504                         set s disabled
3505                 } else {
3506                         set s normal
3507                 }
3508                 $ctxm entryconf $::ui_diff_applyhunk -state $s -label $l
3509                 $ctxm entryconf $::ui_diff_applyline -state $s -label $t
3510                 tk_popup $ctxm $X $Y
3511         }
3512 }
3513 bind_button3 $ui_diff [list popup_diff_menu $ctxm $ctxmmg $ctxmsm %x %y %X %Y]
3514
3515 # -- Status Bar
3516 #
3517 set main_status [::status_bar::new .status]
3518 pack .status -anchor w -side bottom -fill x
3519 $main_status show [mc "Initializing..."]
3520
3521 # -- Load geometry
3522 #
3523 proc on_ttk_pane_mapped {w pane pos} {
3524         bind $w <Map> {}
3525         after 0 [list after idle [list $w sashpos $pane $pos]]
3526 }
3527 proc on_tk_pane_mapped {w pane x y} {
3528         bind $w <Map> {}
3529         after 0 [list after idle [list $w sash place $pane $x $y]]
3530 }
3531 proc on_application_mapped {} {
3532         global repo_config use_ttk
3533         bind . <Map> {}
3534         set gm $repo_config(gui.geometry)
3535         if {$use_ttk} {
3536                 bind .vpane <Map> \
3537                     [list on_ttk_pane_mapped %W 0 [lindex $gm 1]]
3538                 bind .vpane.files <Map> \
3539                     [list on_ttk_pane_mapped %W 0 [lindex $gm 2]]
3540         } else {
3541                 bind .vpane <Map> \
3542                     [list on_tk_pane_mapped %W 0 \
3543                          [lindex $gm 1] \
3544                          [lindex [.vpane sash coord 0] 1]]
3545                 bind .vpane.files <Map> \
3546                     [list on_tk_pane_mapped %W 0 \
3547                          [lindex [.vpane.files sash coord 0] 0] \
3548                          [lindex $gm 2]]
3549         }
3550         wm geometry . [lindex $gm 0]
3551 }
3552 if {[info exists repo_config(gui.geometry)]} {
3553         bind . <Map> [list on_application_mapped]
3554         wm geometry . [lindex $repo_config(gui.geometry) 0]
3555 }
3556
3557 # -- Load window state
3558 #
3559 if {[info exists repo_config(gui.wmstate)]} {
3560         catch {wm state . $repo_config(gui.wmstate)}
3561 }
3562
3563 # -- Key Bindings
3564 #
3565 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3566 bind $ui_comm <$M1B-Key-t> {do_add_selection;break}
3567 bind $ui_comm <$M1B-Key-T> {do_add_selection;break}
3568 bind $ui_comm <$M1B-Key-u> {do_unstage_selection;break}
3569 bind $ui_comm <$M1B-Key-U> {do_unstage_selection;break}
3570 bind $ui_comm <$M1B-Key-j> {do_revert_selection;break}
3571 bind $ui_comm <$M1B-Key-J> {do_revert_selection;break}
3572 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
3573 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
3574 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3575 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3576 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3577 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3578 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3579 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3580 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3581 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3582 bind $ui_comm <$M1B-Key-minus> {show_less_context;break}
3583 bind $ui_comm <$M1B-Key-KP_Subtract> {show_less_context;break}
3584 bind $ui_comm <$M1B-Key-equal> {show_more_context;break}
3585 bind $ui_comm <$M1B-Key-plus> {show_more_context;break}
3586 bind $ui_comm <$M1B-Key-KP_Add> {show_more_context;break}
3587
3588 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3589 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3590 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3591 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3592 bind $ui_diff <$M1B-Key-v> {break}
3593 bind $ui_diff <$M1B-Key-V> {break}
3594 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3595 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3596 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3597 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3598 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3599 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3600 bind $ui_diff <Key-k>         {catch {%W yview scroll -1 units};break}
3601 bind $ui_diff <Key-j>         {catch {%W yview scroll  1 units};break}
3602 bind $ui_diff <Key-h>         {catch {%W xview scroll -1 units};break}
3603 bind $ui_diff <Key-l>         {catch {%W xview scroll  1 units};break}
3604 bind $ui_diff <Control-Key-b> {catch {%W yview scroll -1 pages};break}
3605 bind $ui_diff <Control-Key-f> {catch {%W yview scroll  1 pages};break}
3606 bind $ui_diff <Button-1>   {focus %W}
3607
3608 if {[is_enabled branch]} {
3609         bind . <$M1B-Key-n> branch_create::dialog
3610         bind . <$M1B-Key-N> branch_create::dialog
3611         bind . <$M1B-Key-o> branch_checkout::dialog
3612         bind . <$M1B-Key-O> branch_checkout::dialog
3613         bind . <$M1B-Key-m> merge::dialog
3614         bind . <$M1B-Key-M> merge::dialog
3615 }
3616 if {[is_enabled transport]} {
3617         bind . <$M1B-Key-p> do_push_anywhere
3618         bind . <$M1B-Key-P> do_push_anywhere
3619 }
3620
3621 bind .   <Key-F5>     ui_do_rescan
3622 bind .   <$M1B-Key-r> ui_do_rescan
3623 bind .   <$M1B-Key-R> ui_do_rescan
3624 bind .   <$M1B-Key-s> do_signoff
3625 bind .   <$M1B-Key-S> do_signoff
3626 bind .   <$M1B-Key-t> do_add_selection
3627 bind .   <$M1B-Key-T> do_add_selection
3628 bind .   <$M1B-Key-j> do_revert_selection
3629 bind .   <$M1B-Key-J> do_revert_selection
3630 bind .   <$M1B-Key-i> do_add_all
3631 bind .   <$M1B-Key-I> do_add_all
3632 bind .   <$M1B-Key-minus> {show_less_context;break}
3633 bind .   <$M1B-Key-KP_Subtract> {show_less_context;break}
3634 bind .   <$M1B-Key-equal> {show_more_context;break}
3635 bind .   <$M1B-Key-plus> {show_more_context;break}
3636 bind .   <$M1B-Key-KP_Add> {show_more_context;break}
3637 bind .   <$M1B-Key-Return> do_commit
3638 foreach i [list $ui_index $ui_workdir] {
3639         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3640         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3641         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3642 }
3643 unset i
3644
3645 set file_lists($ui_index) [list]
3646 set file_lists($ui_workdir) [list]
3647
3648 wm title . "[appname] ([reponame]) [file normalize $_gitworktree]"
3649 focus -force $ui_comm
3650
3651 # -- Warn the user about environmental problems.  Cygwin's Tcl
3652 #    does *not* pass its env array onto any processes it spawns.
3653 #    This means that git processes get none of our environment.
3654 #
3655 if {[is_Cygwin]} {
3656         set ignored_env 0
3657         set suggest_user {}
3658         set msg [mc "Possible environment issues exist.
3659
3660 The following environment variables are probably
3661 going to be ignored by any Git subprocess run
3662 by %s:
3663
3664 " [appname]]
3665         foreach name [array names env] {
3666                 switch -regexp -- $name {
3667                 {^GIT_INDEX_FILE$} -
3668                 {^GIT_OBJECT_DIRECTORY$} -
3669                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3670                 {^GIT_DIFF_OPTS$} -
3671                 {^GIT_EXTERNAL_DIFF$} -
3672                 {^GIT_PAGER$} -
3673                 {^GIT_TRACE$} -
3674                 {^GIT_CONFIG$} -
3675                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3676                         append msg " - $name\n"
3677                         incr ignored_env
3678                 }
3679                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3680                         append msg " - $name\n"
3681                         incr ignored_env
3682                         set suggest_user $name
3683                 }
3684                 }
3685         }
3686         if {$ignored_env > 0} {
3687                 append msg [mc "
3688 This is due to a known issue with the
3689 Tcl binary distributed by Cygwin."]
3690
3691                 if {$suggest_user ne {}} {
3692                         append msg [mc "
3693
3694 A good replacement for %s
3695 is placing values for the user.name and
3696 user.email settings into your personal
3697 ~/.gitconfig file.
3698 " $suggest_user]
3699                 }
3700                 warn_popup $msg
3701         }
3702         unset ignored_env msg suggest_user name
3703 }
3704
3705 # -- Only initialize complex UI if we are going to stay running.
3706 #
3707 if {[is_enabled transport]} {
3708         load_all_remotes
3709
3710         set n [.mbar.remote index end]
3711         populate_remotes_menu
3712         set n [expr {[.mbar.remote index end] - $n}]
3713         if {$n > 0} {
3714                 if {[.mbar.remote type 0] eq "tearoff"} { incr n }
3715                 .mbar.remote insert $n separator
3716         }
3717         unset n
3718 }
3719
3720 if {[winfo exists $ui_comm]} {
3721         set GITGUI_BCK_exists [load_message GITGUI_BCK]
3722
3723         # -- If both our backup and message files exist use the
3724         #    newer of the two files to initialize the buffer.
3725         #
3726         if {$GITGUI_BCK_exists} {
3727                 set m [gitdir GITGUI_MSG]
3728                 if {[file isfile $m]} {
3729                         if {[file mtime [gitdir GITGUI_BCK]] > [file mtime $m]} {
3730                                 catch {file delete [gitdir GITGUI_MSG]}
3731                         } else {
3732                                 $ui_comm delete 0.0 end
3733                                 $ui_comm edit reset
3734                                 $ui_comm edit modified false
3735                                 catch {file delete [gitdir GITGUI_BCK]}
3736                                 set GITGUI_BCK_exists 0
3737                         }
3738                 }
3739                 unset m
3740         }
3741
3742         proc backup_commit_buffer {} {
3743                 global ui_comm GITGUI_BCK_exists
3744
3745                 set m [$ui_comm edit modified]
3746                 if {$m || $GITGUI_BCK_exists} {
3747                         set msg [string trim [$ui_comm get 0.0 end]]
3748                         regsub -all -line {[ \r\t]+$} $msg {} msg
3749
3750                         if {$msg eq {}} {
3751                                 if {$GITGUI_BCK_exists} {
3752                                         catch {file delete [gitdir GITGUI_BCK]}
3753                                         set GITGUI_BCK_exists 0
3754                                 }
3755                         } elseif {$m} {
3756                                 catch {
3757                                         set fd [open [gitdir GITGUI_BCK] w]
3758                                         puts -nonewline $fd $msg
3759                                         close $fd
3760                                         set GITGUI_BCK_exists 1
3761                                 }
3762                         }
3763
3764                         $ui_comm edit modified false
3765                 }
3766
3767                 set ::GITGUI_BCK_i [after 2000 backup_commit_buffer]
3768         }
3769
3770         backup_commit_buffer
3771
3772         # -- If the user has aspell available we can drive it
3773         #    in pipe mode to spellcheck the commit message.
3774         #
3775         set spell_cmd [list |]
3776         set spell_dict [get_config gui.spellingdictionary]
3777         lappend spell_cmd aspell
3778         if {$spell_dict ne {}} {
3779                 lappend spell_cmd --master=$spell_dict
3780         }
3781         lappend spell_cmd --mode=none
3782         lappend spell_cmd --encoding=utf-8
3783         lappend spell_cmd pipe
3784         if {$spell_dict eq {none}
3785          || [catch {set spell_fd [open $spell_cmd r+]} spell_err]} {
3786                 bind_button3 $ui_comm [list tk_popup $ui_comm_ctxm %X %Y]
3787         } else {
3788                 set ui_comm_spell [spellcheck::init \
3789                         $spell_fd \
3790                         $ui_comm \
3791                         $ui_comm_ctxm \
3792                 ]
3793         }
3794         unset -nocomplain spell_cmd spell_fd spell_err spell_dict
3795 }
3796
3797 lock_index begin-read
3798 if {![winfo ismapped .]} {
3799         wm deiconify .
3800 }
3801 after 1 {
3802         if {[is_enabled initialamend]} {
3803                 force_amend
3804         } else {
3805                 do_rescan
3806         }
3807
3808         if {[is_enabled nocommitmsg]} {
3809                 $ui_comm configure -state disabled -background gray
3810         }
3811 }
3812 if {[is_enabled multicommit]} {
3813         after 1000 hint_gc
3814 }
3815 if {[is_enabled retcode]} {
3816         bind . <Destroy> {+terminate_me %W}
3817 }
3818 if {$picked && [is_config_true gui.autoexplore]} {
3819         do_explore
3820 }
3821
3822 # Local variables:
3823 # mode: tcl
3824 # indent-tabs-mode: t
3825 # tab-width: 4
3826 # End: