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

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 set appvers {@@GITGUI_VERSION@@}
   6 set copyright {
   7 Copyright © 2006, 2007 Shawn Pearce, et. al.
   8
   9 This program is free software; you can redistribute it and/or modify
  10 it under the terms of the GNU General Public License as published by
  11 the Free Software Foundation; either version 2 of the License, or
  12 (at your option) any later version.
  13
  14 This program is distributed in the hope that it will be useful,
  15 but WITHOUT ANY WARRANTY; without even the implied warranty of
  16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  17 GNU General Public License for more details.
  18
  19 You should have received a copy of the GNU General Public License
  20 along with this program; if not, write to the Free Software
  21 Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA}
  22 set gitgui_credits {
  23 Paul Mackerras
  24 }
  25
  26 ######################################################################
  27 ##
  28 ## read only globals
  29
  30 set _appname [lindex [file split $argv0] end]
  31 set _gitdir {}
  32 set _gitexec {}
  33 set _reponame {}
  34 set _iscygwin {}
  35
  36 proc appname {} {
  37         global _appname
  38         return $_appname
  39 }
  40
  41 proc gitdir {args} {
  42         global _gitdir
  43         if {$args eq {}} {
  44                 return $_gitdir
  45         }
  46         return [eval [concat [list file join $_gitdir] $args]]
  47 }
  48
  49 proc gitexec {args} {
  50         global _gitexec
  51         if {$_gitexec eq {}} {
  52                 if {[catch {set _gitexec [git --exec-path]} err]} {
  53                         error "Git not installed?\n\n$err"
  54                 }
  55         }
  56         if {$args eq {}} {
  57                 return $_gitexec
  58         }
  59         return [eval [concat [list file join $_gitexec] $args]]
  60 }
  61
  62 proc reponame {} {
  63         global _reponame
  64         return $_reponame
  65 }
  66
  67 proc is_MacOSX {} {
  68         global tcl_platform tk_library
  69         if {[tk windowingsystem] eq {aqua}} {
  70                 return 1
  71         }
  72         return 0
  73 }
  74
  75 proc is_Windows {} {
  76         global tcl_platform
  77         if {$tcl_platform(platform) eq {windows}} {
  78                 return 1
  79         }
  80         return 0
  81 }
  82
  83 proc is_Cygwin {} {
  84         global tcl_platform _iscygwin
  85         if {$_iscygwin eq {}} {
  86                 if {$tcl_platform(platform) eq {windows}} {
  87                         if {[catch {set p [exec cygpath --windir]} err]} {
  88                                 set _iscygwin 0
  89                         } else {
  90                                 set _iscygwin 1
  91                         }
  92                 } else {
  93                         set _iscygwin 0
  94                 }
  95         }
  96         return $_iscygwin
  97 }
  98
  99 proc is_enabled {option} {
 100         global enabled_options
 101         if {[catch {set on $enabled_options($option)}]} {return 0}
 102         return $on
 103 }
 104
 105 proc enable_option {option} {
 106         global enabled_options
 107         set enabled_options($option) 1
 108 }
 109
 110 proc disable_option {option} {
 111         global enabled_options
 112         set enabled_options($option) 0
 113 }
 114
 115 ######################################################################
 116 ##
 117 ## config
 118
 119 proc is_many_config {name} {
 120         switch -glob -- $name {
 121         remote.*.fetch -
 122         remote.*.push
 123                 {return 1}
 124         *
 125                 {return 0}
 126         }
 127 }
 128
 129 proc is_config_true {name} {
 130         global repo_config
 131         if {[catch {set v $repo_config($name)}]} {
 132                 return 0
 133         } elseif {$v eq {true} || $v eq {1} || $v eq {yes}} {
 134                 return 1
 135         } else {
 136                 return 0
 137         }
 138 }
 139
 140 proc load_config {include_global} {
 141         global repo_config global_config default_config
 142
 143         array unset global_config
 144         if {$include_global} {
 145                 catch {
 146                         set fd_rc [open "| git config --global --list" r]
 147                         while {[gets $fd_rc line] >= 0} {
 148                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 149                                         if {[is_many_config $name]} {
 150                                                 lappend global_config($name) $value
 151                                         } else {
 152                                                 set global_config($name) $value
 153                                         }
 154                                 }
 155                         }
 156                         close $fd_rc
 157                 }
 158         }
 159
 160         array unset repo_config
 161         catch {
 162                 set fd_rc [open "| git config --list" r]
 163                 while {[gets $fd_rc line] >= 0} {
 164                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
 165                                 if {[is_many_config $name]} {
 166                                         lappend repo_config($name) $value
 167                                 } else {
 168                                         set repo_config($name) $value
 169                                 }
 170                         }
 171                 }
 172                 close $fd_rc
 173         }
 174
 175         foreach name [array names default_config] {
 176                 if {[catch {set v $global_config($name)}]} {
 177                         set global_config($name) $default_config($name)
 178                 }
 179                 if {[catch {set v $repo_config($name)}]} {
 180                         set repo_config($name) $default_config($name)
 181                 }
 182         }
 183 }
 184
 185 proc save_config {} {
 186         global default_config font_descs
 187         global repo_config global_config
 188         global repo_config_new global_config_new
 189
 190         foreach option $font_descs {
 191                 set name [lindex $option 0]
 192                 set font [lindex $option 1]
 193                 font configure $font \
 194                         -family $global_config_new(gui.$font^^family) \
 195                         -size $global_config_new(gui.$font^^size)
 196                 font configure ${font}bold \
 197                         -family $global_config_new(gui.$font^^family) \
 198                         -size $global_config_new(gui.$font^^size)
 199                 set global_config_new(gui.$name) [font configure $font]
 200                 unset global_config_new(gui.$font^^family)
 201                 unset global_config_new(gui.$font^^size)
 202         }
 203
 204         foreach name [array names default_config] {
 205                 set value $global_config_new($name)
 206                 if {$value ne $global_config($name)} {
 207                         if {$value eq $default_config($name)} {
 208                                 catch {git config --global --unset $name}
 209                         } else {
 210                                 regsub -all "\[{}\]" $value {"} value
 211                                 git config --global $name $value
 212                         }
 213                         set global_config($name) $value
 214                         if {$value eq $repo_config($name)} {
 215                                 catch {git config --unset $name}
 216                                 set repo_config($name) $value
 217                         }
 218                 }
 219         }
 220
 221         foreach name [array names default_config] {
 222                 set value $repo_config_new($name)
 223                 if {$value ne $repo_config($name)} {
 224                         if {$value eq $global_config($name)} {
 225                                 catch {git config --unset $name}
 226                         } else {
 227                                 regsub -all "\[{}\]" $value {"} value
 228                                 git config $name $value
 229                         }
 230                         set repo_config($name) $value
 231                 }
 232         }
 233 }
 234
 235 ######################################################################
 236 ##
 237 ## handy utils
 238
 239 proc git {args} {
 240         return [eval exec git $args]
 241 }
 242
 243 proc error_popup {msg} {
 244         set title [appname]
 245         if {[reponame] ne {}} {
 246                 append title " ([reponame])"
 247         }
 248         set cmd [list tk_messageBox \
 249                 -icon error \
 250                 -type ok \
 251                 -title "$title: error" \
 252                 -message $msg]
 253         if {[winfo ismapped .]} {
 254                 lappend cmd -parent .
 255         }
 256         eval $cmd
 257 }
 258
 259 proc warn_popup {msg} {
 260         set title [appname]
 261         if {[reponame] ne {}} {
 262                 append title " ([reponame])"
 263         }
 264         set cmd [list tk_messageBox \
 265                 -icon warning \
 266                 -type ok \
 267                 -title "$title: warning" \
 268                 -message $msg]
 269         if {[winfo ismapped .]} {
 270                 lappend cmd -parent .
 271         }
 272         eval $cmd
 273 }
 274
 275 proc info_popup {msg {parent .}} {
 276         set title [appname]
 277         if {[reponame] ne {}} {
 278                 append title " ([reponame])"
 279         }
 280         tk_messageBox \
 281                 -parent $parent \
 282                 -icon info \
 283                 -type ok \
 284                 -title $title \
 285                 -message $msg
 286 }
 287
 288 proc ask_popup {msg} {
 289         set title [appname]
 290         if {[reponame] ne {}} {
 291                 append title " ([reponame])"
 292         }
 293         return [tk_messageBox \
 294                 -parent . \
 295                 -icon question \
 296                 -type yesno \
 297                 -title $title \
 298                 -message $msg]
 299 }
 300
 301 ######################################################################
 302 ##
 303 ## version check
 304
 305 set req_maj 1
 306 set req_min 5
 307
 308 if {[catch {set v [git --version]} err]} {
 309         catch {wm withdraw .}
 310         error_popup "Cannot determine Git version:
 311
 312 $err
 313
 314 [appname] requires Git $req_maj.$req_min or later."
 315         exit 1
 316 }
 317 if {[regexp {^git version (\d+)\.(\d+)} $v _junk act_maj act_min]} {
 318         if {$act_maj < $req_maj
 319                 || ($act_maj == $req_maj && $act_min < $req_min)} {
 320                 catch {wm withdraw .}
 321                 error_popup "[appname] requires Git $req_maj.$req_min or later.
 322
 323 You are using $v."
 324                 exit 1
 325         }
 326 } else {
 327         catch {wm withdraw .}
 328         error_popup "Cannot parse Git version string:\n\n$v"
 329         exit 1
 330 }
 331 unset -nocomplain v _junk act_maj act_min req_maj req_min
 332
 333 ######################################################################
 334 ##
 335 ## repository setup
 336
 337 if {   [catch {set _gitdir $env(GIT_DIR)}]
 338         && [catch {set _gitdir [git rev-parse --git-dir]} err]} {
 339         catch {wm withdraw .}
 340         error_popup "Cannot find the git directory:\n\n$err"
 341         exit 1
 342 }
 343 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 344         catch {set _gitdir [exec cygpath --unix $_gitdir]}
 345 }
 346 if {![file isdirectory $_gitdir]} {
 347         catch {wm withdraw .}
 348         error_popup "Git directory not found:\n\n$_gitdir"
 349         exit 1
 350 }
 351 if {[lindex [file split $_gitdir] end] ne {.git}} {
 352         catch {wm withdraw .}
 353         error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 354         exit 1
 355 }
 356 if {[catch {cd [file dirname $_gitdir]} err]} {
 357         catch {wm withdraw .}
 358         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 359         exit 1
 360 }
 361 set _reponame [lindex [file split \
 362         [file normalize [file dirname $_gitdir]]] \
 363         end]
 364
 365 ######################################################################
 366 ##
 367 ## global init
 368
 369 set current_diff_path {}
 370 set current_diff_side {}
 371 set diff_actions [list]
 372 set ui_status_value {Initializing...}
 373
 374 set HEAD {}
 375 set PARENT {}
 376 set MERGE_HEAD [list]
 377 set commit_type {}
 378 set empty_tree {}
 379 set current_branch {}
 380 set current_diff_path {}
 381 set selected_commit_type new
 382
 383 ######################################################################
 384 ##
 385 ## task management
 386
 387 set rescan_active 0
 388 set diff_active 0
 389 set last_clicked {}
 390
 391 set disable_on_lock [list]
 392 set index_lock_type none
 393
 394 proc lock_index {type} {
 395         global index_lock_type disable_on_lock
 396
 397         if {$index_lock_type eq {none}} {
 398                 set index_lock_type $type
 399                 foreach w $disable_on_lock {
 400                         uplevel #0 $w disabled
 401                 }
 402                 return 1
 403         } elseif {$index_lock_type eq "begin-$type"} {
 404                 set index_lock_type $type
 405                 return 1
 406         }
 407         return 0
 408 }
 409
 410 proc unlock_index {} {
 411         global index_lock_type disable_on_lock
 412
 413         set index_lock_type none
 414         foreach w $disable_on_lock {
 415                 uplevel #0 $w normal
 416         }
 417 }
 418
 419 ######################################################################
 420 ##
 421 ## status
 422
 423 proc repository_state {ctvar hdvar mhvar} {
 424         global current_branch
 425         upvar $ctvar ct $hdvar hd $mhvar mh
 426
 427         set mh [list]
 428
 429         if {[catch {set current_branch [git symbolic-ref HEAD]}]} {
 430                 set current_branch {}
 431         } else {
 432                 regsub ^refs/((heads|tags|remotes)/)? \
 433                         $current_branch \
 434                         {} \
 435                         current_branch
 436         }
 437
 438         if {[catch {set hd [git rev-parse --verify HEAD]}]} {
 439                 set hd {}
 440                 set ct initial
 441                 return
 442         }
 443
 444         set merge_head [gitdir MERGE_HEAD]
 445         if {[file exists $merge_head]} {
 446                 set ct merge
 447                 set fd_mh [open $merge_head r]
 448                 while {[gets $fd_mh line] >= 0} {
 449                         lappend mh $line
 450                 }
 451                 close $fd_mh
 452                 return
 453         }
 454
 455         set ct normal
 456 }
 457
 458 proc PARENT {} {
 459         global PARENT empty_tree
 460
 461         set p [lindex $PARENT 0]
 462         if {$p ne {}} {
 463                 return $p
 464         }
 465         if {$empty_tree eq {}} {
 466                 set empty_tree [git mktree << {}]
 467         }
 468         return $empty_tree
 469 }
 470
 471 proc rescan {after {honor_trustmtime 1}} {
 472         global HEAD PARENT MERGE_HEAD commit_type
 473         global ui_index ui_workdir ui_status_value ui_comm
 474         global rescan_active file_states
 475         global repo_config
 476
 477         if {$rescan_active > 0 || ![lock_index read]} return
 478
 479         repository_state newType newHEAD newMERGE_HEAD
 480         if {[string match amend* $commit_type]
 481                 && $newType eq {normal}
 482                 && $newHEAD eq $HEAD} {
 483         } else {
 484                 set HEAD $newHEAD
 485                 set PARENT $newHEAD
 486                 set MERGE_HEAD $newMERGE_HEAD
 487                 set commit_type $newType
 488         }
 489
 490         array unset file_states
 491
 492         if {![$ui_comm edit modified]
 493                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 494                 if {[load_message GITGUI_MSG]} {
 495                 } elseif {[load_message MERGE_MSG]} {
 496                 } elseif {[load_message SQUASH_MSG]} {
 497                 }
 498                 $ui_comm edit reset
 499                 $ui_comm edit modified false
 500         }
 501
 502         if {[is_enabled branch]} {
 503                 load_all_heads
 504                 populate_branch_menu
 505         }
 506
 507         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 508                 rescan_stage2 {} $after
 509         } else {
 510                 set rescan_active 1
 511                 set ui_status_value {Refreshing file status...}
 512                 set cmd [list git update-index]
 513                 lappend cmd -q
 514                 lappend cmd --unmerged
 515                 lappend cmd --ignore-missing
 516                 lappend cmd --refresh
 517                 set fd_rf [open "| $cmd" r]
 518                 fconfigure $fd_rf -blocking 0 -translation binary
 519                 fileevent $fd_rf readable \
 520                         [list rescan_stage2 $fd_rf $after]
 521         }
 522 }
 523
 524 proc rescan_stage2 {fd after} {
 525         global ui_status_value
 526         global rescan_active buf_rdi buf_rdf buf_rlo
 527
 528         if {$fd ne {}} {
 529                 read $fd
 530                 if {![eof $fd]} return
 531                 close $fd
 532         }
 533
 534         set ls_others [list | git ls-files --others -z \
 535                 --exclude-per-directory=.gitignore]
 536         set info_exclude [gitdir info exclude]
 537         if {[file readable $info_exclude]} {
 538                 lappend ls_others "--exclude-from=$info_exclude"
 539         }
 540
 541         set buf_rdi {}
 542         set buf_rdf {}
 543         set buf_rlo {}
 544
 545         set rescan_active 3
 546         set ui_status_value {Scanning for modified files ...}
 547         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 548         set fd_df [open "| git diff-files -z" r]
 549         set fd_lo [open $ls_others r]
 550
 551         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 552         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 553         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 554         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 555         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 556         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 557 }
 558
 559 proc load_message {file} {
 560         global ui_comm
 561
 562         set f [gitdir $file]
 563         if {[file isfile $f]} {
 564                 if {[catch {set fd [open $f r]}]} {
 565                         return 0
 566                 }
 567                 set content [string trim [read $fd]]
 568                 close $fd
 569                 regsub -all -line {[ \r\t]+$} $content {} content
 570                 $ui_comm delete 0.0 end
 571                 $ui_comm insert end $content
 572                 return 1
 573         }
 574         return 0
 575 }
 576
 577 proc read_diff_index {fd after} {
 578         global buf_rdi
 579
 580         append buf_rdi [read $fd]
 581         set c 0
 582         set n [string length $buf_rdi]
 583         while {$c < $n} {
 584                 set z1 [string first "\0" $buf_rdi $c]
 585                 if {$z1 == -1} break
 586                 incr z1
 587                 set z2 [string first "\0" $buf_rdi $z1]
 588                 if {$z2 == -1} break
 589
 590                 incr c
 591                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 592                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 593                 merge_state \
 594                         [encoding convertfrom $p] \
 595                         [lindex $i 4]? \
 596                         [list [lindex $i 0] [lindex $i 2]] \
 597                         [list]
 598                 set c $z2
 599                 incr c
 600         }
 601         if {$c < $n} {
 602                 set buf_rdi [string range $buf_rdi $c end]
 603         } else {
 604                 set buf_rdi {}
 605         }
 606
 607         rescan_done $fd buf_rdi $after
 608 }
 609
 610 proc read_diff_files {fd after} {
 611         global buf_rdf
 612
 613         append buf_rdf [read $fd]
 614         set c 0
 615         set n [string length $buf_rdf]
 616         while {$c < $n} {
 617                 set z1 [string first "\0" $buf_rdf $c]
 618                 if {$z1 == -1} break
 619                 incr z1
 620                 set z2 [string first "\0" $buf_rdf $z1]
 621                 if {$z2 == -1} break
 622
 623                 incr c
 624                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 625                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 626                 merge_state \
 627                         [encoding convertfrom $p] \
 628                         ?[lindex $i 4] \
 629                         [list] \
 630                         [list [lindex $i 0] [lindex $i 2]]
 631                 set c $z2
 632                 incr c
 633         }
 634         if {$c < $n} {
 635                 set buf_rdf [string range $buf_rdf $c end]
 636         } else {
 637                 set buf_rdf {}
 638         }
 639
 640         rescan_done $fd buf_rdf $after
 641 }
 642
 643 proc read_ls_others {fd after} {
 644         global buf_rlo
 645
 646         append buf_rlo [read $fd]
 647         set pck [split $buf_rlo "\0"]
 648         set buf_rlo [lindex $pck end]
 649         foreach p [lrange $pck 0 end-1] {
 650                 merge_state [encoding convertfrom $p] ?O
 651         }
 652         rescan_done $fd buf_rlo $after
 653 }
 654
 655 proc rescan_done {fd buf after} {
 656         global rescan_active
 657         global file_states repo_config
 658         upvar $buf to_clear
 659
 660         if {![eof $fd]} return
 661         set to_clear {}
 662         close $fd
 663         if {[incr rescan_active -1] > 0} return
 664
 665         prune_selection
 666         unlock_index
 667         display_all_files
 668         reshow_diff
 669         uplevel #0 $after
 670 }
 671
 672 proc prune_selection {} {
 673         global file_states selected_paths
 674
 675         foreach path [array names selected_paths] {
 676                 if {[catch {set still_here $file_states($path)}]} {
 677                         unset selected_paths($path)
 678                 }
 679         }
 680 }
 681
 682 ######################################################################
 683 ##
 684 ## diff
 685
 686 proc clear_diff {} {
 687         global ui_diff current_diff_path current_diff_header
 688         global ui_index ui_workdir
 689
 690         $ui_diff conf -state normal
 691         $ui_diff delete 0.0 end
 692         $ui_diff conf -state disabled
 693
 694         set current_diff_path {}
 695         set current_diff_header {}
 696
 697         $ui_index tag remove in_diff 0.0 end
 698         $ui_workdir tag remove in_diff 0.0 end
 699 }
 700
 701 proc reshow_diff {} {
 702         global ui_status_value file_states file_lists
 703         global current_diff_path current_diff_side
 704
 705         set p $current_diff_path
 706         if {$p eq {}} {
 707                 # No diff is being shown.
 708         } elseif {$current_diff_side eq {}
 709                 || [catch {set s $file_states($p)}]
 710                 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 711                 clear_diff
 712         } else {
 713                 show_diff $p $current_diff_side
 714         }
 715 }
 716
 717 proc handle_empty_diff {} {
 718         global current_diff_path file_states file_lists
 719
 720         set path $current_diff_path
 721         set s $file_states($path)
 722         if {[lindex $s 0] ne {_M}} return
 723
 724         info_popup "No differences detected.
 725
 726 [short_path $path] has no changes.
 727
 728 The modification date of this file was updated
 729 by another application, but the content within
 730 the file was not changed.
 731
 732 A rescan will be automatically started to find
 733 other files which may have the same state."
 734
 735         clear_diff
 736         display_file $path __
 737         rescan {set ui_status_value {Ready.}} 0
 738 }
 739
 740 proc show_diff {path w {lno {}}} {
 741         global file_states file_lists
 742         global is_3way_diff diff_active repo_config
 743         global ui_diff ui_status_value ui_index ui_workdir
 744         global current_diff_path current_diff_side current_diff_header
 745
 746         if {$diff_active || ![lock_index read]} return
 747
 748         clear_diff
 749         if {$lno == {}} {
 750                 set lno [lsearch -sorted -exact $file_lists($w) $path]
 751                 if {$lno >= 0} {
 752                         incr lno
 753                 }
 754         }
 755         if {$lno >= 1} {
 756                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 757         }
 758
 759         set s $file_states($path)
 760         set m [lindex $s 0]
 761         set is_3way_diff 0
 762         set diff_active 1
 763         set current_diff_path $path
 764         set current_diff_side $w
 765         set current_diff_header {}
 766         set ui_status_value "Loading diff of [escape_path $path]..."
 767
 768         # - Git won't give us the diff, there's nothing to compare to!
 769         #
 770         if {$m eq {_O}} {
 771                 set max_sz [expr {128 * 1024}]
 772                 if {[catch {
 773                                 set fd [open $path r]
 774                                 set content [read $fd $max_sz]
 775                                 close $fd
 776                                 set sz [file size $path]
 777                         } err ]} {
 778                         set diff_active 0
 779                         unlock_index
 780                         set ui_status_value "Unable to display [escape_path $path]"
 781                         error_popup "Error loading file:\n\n$err"
 782                         return
 783                 }
 784                 $ui_diff conf -state normal
 785                 if {![catch {set type [exec file $path]}]} {
 786                         set n [string length $path]
 787                         if {[string equal -length $n $path $type]} {
 788                                 set type [string range $type $n end]
 789                                 regsub {^:?\s*} $type {} type
 790                         }
 791                         $ui_diff insert end "* $type\n" d_@
 792                 }
 793                 if {[string first "\0" $content] != -1} {
 794                         $ui_diff insert end \
 795                                 "* Binary file (not showing content)." \
 796                                 d_@
 797                 } else {
 798                         if {$sz > $max_sz} {
 799                                 $ui_diff insert end \
 800 "* Untracked file is $sz bytes.
 801 * Showing only first $max_sz bytes.
 802 " d_@
 803                         }
 804                         $ui_diff insert end $content
 805                         if {$sz > $max_sz} {
 806                                 $ui_diff insert end "
 807 * Untracked file clipped here by [appname].
 808 * To see the entire file, use an external editor.
 809 " d_@
 810                         }
 811                 }
 812                 $ui_diff conf -state disabled
 813                 set diff_active 0
 814                 unlock_index
 815                 set ui_status_value {Ready.}
 816                 return
 817         }
 818
 819         set cmd [list | git]
 820         if {$w eq $ui_index} {
 821                 lappend cmd diff-index
 822                 lappend cmd --cached
 823         } elseif {$w eq $ui_workdir} {
 824                 if {[string index $m 0] eq {U}} {
 825                         lappend cmd diff
 826                 } else {
 827                         lappend cmd diff-files
 828                 }
 829         }
 830
 831         lappend cmd -p
 832         lappend cmd --no-color
 833         if {$repo_config(gui.diffcontext) > 0} {
 834                 lappend cmd "-U$repo_config(gui.diffcontext)"
 835         }
 836         if {$w eq $ui_index} {
 837                 lappend cmd [PARENT]
 838         }
 839         lappend cmd --
 840         lappend cmd $path
 841
 842         if {[catch {set fd [open $cmd r]} err]} {
 843                 set diff_active 0
 844                 unlock_index
 845                 set ui_status_value "Unable to display [escape_path $path]"
 846                 error_popup "Error loading diff:\n\n$err"
 847                 return
 848         }
 849
 850         fconfigure $fd \
 851                 -blocking 0 \
 852                 -encoding binary \
 853                 -translation binary
 854         fileevent $fd readable [list read_diff $fd]
 855 }
 856
 857 proc read_diff {fd} {
 858         global ui_diff ui_status_value diff_active
 859         global is_3way_diff current_diff_header
 860
 861         $ui_diff conf -state normal
 862         while {[gets $fd line] >= 0} {
 863                 # -- Cleanup uninteresting diff header lines.
 864                 #
 865                 if {   [string match {diff --git *}      $line]
 866                         || [string match {diff --cc *}       $line]
 867                         || [string match {diff --combined *} $line]
 868                         || [string match {--- *}             $line]
 869                         || [string match {+++ *}             $line]} {
 870                         append current_diff_header $line "\n"
 871                         continue
 872                 }
 873                 if {[string match {index *} $line]} continue
 874                 if {$line eq {deleted file mode 120000}} {
 875                         set line "deleted symlink"
 876                 }
 877
 878                 # -- Automatically detect if this is a 3 way diff.
 879                 #
 880                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 881
 882                 if {[string match {mode *} $line]
 883                         || [string match {new file *} $line]
 884                         || [string match {deleted file *} $line]
 885                         || [string match {Binary files * and * differ} $line]
 886                         || $line eq {\ No newline at end of file}
 887                         || [regexp {^\* Unmerged path } $line]} {
 888                         set tags {}
 889                 } elseif {$is_3way_diff} {
 890                         set op [string range $line 0 1]
 891                         switch -- $op {
 892                         {  } {set tags {}}
 893                         {@@} {set tags d_@}
 894                         { +} {set tags d_s+}
 895                         { -} {set tags d_s-}
 896                         {+ } {set tags d_+s}
 897                         {- } {set tags d_-s}
 898                         {--} {set tags d_--}
 899                         {++} {
 900                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 901                                         set line [string replace $line 0 1 {  }]
 902                                         set tags d$op
 903                                 } else {
 904                                         set tags d_++
 905                                 }
 906                         }
 907                         default {
 908                                 puts "error: Unhandled 3 way diff marker: {$op}"
 909                                 set tags {}
 910                         }
 911                         }
 912                 } else {
 913                         set op [string index $line 0]
 914                         switch -- $op {
 915                         { } {set tags {}}
 916                         {@} {set tags d_@}
 917                         {-} {set tags d_-}
 918                         {+} {
 919                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 920                                         set line [string replace $line 0 0 { }]
 921                                         set tags d$op
 922                                 } else {
 923                                         set tags d_+
 924                                 }
 925                         }
 926                         default {
 927                                 puts "error: Unhandled 2 way diff marker: {$op}"
 928                                 set tags {}
 929                         }
 930                         }
 931                 }
 932                 $ui_diff insert end $line $tags
 933                 if {[string index $line end] eq "\r"} {
 934                         $ui_diff tag add d_cr {end - 2c}
 935                 }
 936                 $ui_diff insert end "\n" $tags
 937         }
 938         $ui_diff conf -state disabled
 939
 940         if {[eof $fd]} {
 941                 close $fd
 942                 set diff_active 0
 943                 unlock_index
 944                 set ui_status_value {Ready.}
 945
 946                 if {[$ui_diff index end] eq {2.0}} {
 947                         handle_empty_diff
 948                 }
 949         }
 950 }
 951
 952 proc apply_hunk {x y} {
 953         global current_diff_path current_diff_header current_diff_side
 954         global ui_diff ui_index file_states
 955
 956         if {$current_diff_path eq {} || $current_diff_header eq {}} return
 957         if {![lock_index apply_hunk]} return
 958
 959         set apply_cmd {git apply --cached --whitespace=nowarn}
 960         set mi [lindex $file_states($current_diff_path) 0]
 961         if {$current_diff_side eq $ui_index} {
 962                 set mode unstage
 963                 lappend apply_cmd --reverse
 964                 if {[string index $mi 0] ne {M}} {
 965                         unlock_index
 966                         return
 967                 }
 968         } else {
 969                 set mode stage
 970                 if {[string index $mi 1] ne {M}} {
 971                         unlock_index
 972                         return
 973                 }
 974         }
 975
 976         set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 977         set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 978         if {$s_lno eq {}} {
 979                 unlock_index
 980                 return
 981         }
 982
 983         set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 984         if {$e_lno eq {}} {
 985                 set e_lno end
 986         }
 987
 988         if {[catch {
 989                 set p [open "| $apply_cmd" w]
 990                 fconfigure $p -translation binary -encoding binary
 991                 puts -nonewline $p $current_diff_header
 992                 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 993                 close $p} err]} {
 994                 error_popup "Failed to $mode selected hunk.\n\n$err"
 995                 unlock_index
 996                 return
 997         }
 998
 999         $ui_diff conf -state normal
1000         $ui_diff delete $s_lno $e_lno
1001         $ui_diff conf -state disabled
1002
1003         if {[$ui_diff get 1.0 end] eq "\n"} {
1004                 set o _
1005         } else {
1006                 set o ?
1007         }
1008
1009         if {$current_diff_side eq $ui_index} {
1010                 set mi ${o}M
1011         } elseif {[string index $mi 0] eq {_}} {
1012                 set mi M$o
1013         } else {
1014                 set mi ?$o
1015         }
1016         unlock_index
1017         display_file $current_diff_path $mi
1018         if {$o eq {_}} {
1019                 clear_diff
1020         }
1021 }
1022
1023 ######################################################################
1024 ##
1025 ## commit
1026
1027 proc load_last_commit {} {
1028         global HEAD PARENT MERGE_HEAD commit_type ui_comm
1029         global repo_config
1030
1031         if {[llength $PARENT] == 0} {
1032                 error_popup {There is nothing to amend.
1033
1034 You are about to create the initial commit.
1035 There is no commit before this to amend.
1036 }
1037                 return
1038         }
1039
1040         repository_state curType curHEAD curMERGE_HEAD
1041         if {$curType eq {merge}} {
1042                 error_popup {Cannot amend while merging.
1043
1044 You are currently in the middle of a merge that
1045 has not been fully completed.  You cannot amend
1046 the prior commit unless you first abort the
1047 current merge activity.
1048 }
1049                 return
1050         }
1051
1052         set msg {}
1053         set parents [list]
1054         if {[catch {
1055                         set fd [open "| git cat-file commit $curHEAD" r]
1056                         fconfigure $fd -encoding binary -translation lf
1057                         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1058                                 set enc utf-8
1059                         }
1060                         while {[gets $fd line] > 0} {
1061                                 if {[string match {parent *} $line]} {
1062                                         lappend parents [string range $line 7 end]
1063                                 } elseif {[string match {encoding *} $line]} {
1064                                         set enc [string tolower [string range $line 9 end]]
1065                                 }
1066                         }
1067                         fconfigure $fd -encoding $enc
1068                         set msg [string trim [read $fd]]
1069                         close $fd
1070                 } err]} {
1071                 error_popup "Error loading commit data for amend:\n\n$err"
1072                 return
1073         }
1074
1075         set HEAD $curHEAD
1076         set PARENT $parents
1077         set MERGE_HEAD [list]
1078         switch -- [llength $parents] {
1079         0       {set commit_type amend-initial}
1080         1       {set commit_type amend}
1081         default {set commit_type amend-merge}
1082         }
1083
1084         $ui_comm delete 0.0 end
1085         $ui_comm insert end $msg
1086         $ui_comm edit reset
1087         $ui_comm edit modified false
1088         rescan {set ui_status_value {Ready.}}
1089 }
1090
1091 proc create_new_commit {} {
1092         global commit_type ui_comm
1093
1094         set commit_type normal
1095         $ui_comm delete 0.0 end
1096         $ui_comm edit reset
1097         $ui_comm edit modified false
1098         rescan {set ui_status_value {Ready.}}
1099 }
1100
1101 set GIT_COMMITTER_IDENT {}
1102
1103 proc committer_ident {} {
1104         global GIT_COMMITTER_IDENT
1105
1106         if {$GIT_COMMITTER_IDENT eq {}} {
1107                 if {[catch {set me [git var GIT_COMMITTER_IDENT]} err]} {
1108                         error_popup "Unable to obtain your identity:\n\n$err"
1109                         return {}
1110                 }
1111                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1112                         $me me GIT_COMMITTER_IDENT]} {
1113                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1114                         return {}
1115                 }
1116         }
1117
1118         return $GIT_COMMITTER_IDENT
1119 }
1120
1121 proc commit_tree {} {
1122         global HEAD commit_type file_states ui_comm repo_config
1123         global ui_status_value pch_error
1124
1125         if {[committer_ident] eq {}} return
1126         if {![lock_index update]} return
1127
1128         # -- Our in memory state should match the repository.
1129         #
1130         repository_state curType curHEAD curMERGE_HEAD
1131         if {[string match amend* $commit_type]
1132                 && $curType eq {normal}
1133                 && $curHEAD eq $HEAD} {
1134         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1135                 info_popup {Last scanned state does not match repository state.
1136
1137 Another Git program has modified this repository
1138 since the last scan.  A rescan must be performed
1139 before another commit can be created.
1140
1141 The rescan will be automatically started now.
1142 }
1143                 unlock_index
1144                 rescan {set ui_status_value {Ready.}}
1145                 return
1146         }
1147
1148         # -- At least one file should differ in the index.
1149         #
1150         set files_ready 0
1151         foreach path [array names file_states] {
1152                 switch -glob -- [lindex $file_states($path) 0] {
1153                 _? {continue}
1154                 A? -
1155                 D? -
1156                 M? {set files_ready 1}
1157                 U? {
1158                         error_popup "Unmerged files cannot be committed.
1159
1160 File [short_path $path] has merge conflicts.
1161 You must resolve them and add the file before committing.
1162 "
1163                         unlock_index
1164                         return
1165                 }
1166                 default {
1167                         error_popup "Unknown file state [lindex $s 0] detected.
1168
1169 File [short_path $path] cannot be committed by this program.
1170 "
1171                 }
1172                 }
1173         }
1174         if {!$files_ready} {
1175                 info_popup {No changes to commit.
1176
1177 You must add at least 1 file before you can commit.
1178 }
1179                 unlock_index
1180                 return
1181         }
1182
1183         # -- A message is required.
1184         #
1185         set msg [string trim [$ui_comm get 1.0 end]]
1186         regsub -all -line {[ \t\r]+$} $msg {} msg
1187         if {$msg eq {}} {
1188                 error_popup {Please supply a commit message.
1189
1190 A good commit message has the following format:
1191
1192 - First line: Describe in one sentance what you did.
1193 - Second line: Blank
1194 - Remaining lines: Describe why this change is good.
1195 }
1196                 unlock_index
1197                 return
1198         }
1199
1200         # -- Run the pre-commit hook.
1201         #
1202         set pchook [gitdir hooks pre-commit]
1203
1204         # On Cygwin [file executable] might lie so we need to ask
1205         # the shell if the hook is executable.  Yes that's annoying.
1206         #
1207         if {[is_Cygwin] && [file isfile $pchook]} {
1208                 set pchook [list sh -c [concat \
1209                         "if test -x \"$pchook\";" \
1210                         "then exec \"$pchook\" 2>&1;" \
1211                         "fi"]]
1212         } elseif {[file executable $pchook]} {
1213                 set pchook [list $pchook |& cat]
1214         } else {
1215                 commit_writetree $curHEAD $msg
1216                 return
1217         }
1218
1219         set ui_status_value {Calling pre-commit hook...}
1220         set pch_error {}
1221         set fd_ph [open "| $pchook" r]
1222         fconfigure $fd_ph -blocking 0 -translation binary
1223         fileevent $fd_ph readable \
1224                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1225 }
1226
1227 proc commit_prehook_wait {fd_ph curHEAD msg} {
1228         global pch_error ui_status_value
1229
1230         append pch_error [read $fd_ph]
1231         fconfigure $fd_ph -blocking 1
1232         if {[eof $fd_ph]} {
1233                 if {[catch {close $fd_ph}]} {
1234                         set ui_status_value {Commit declined by pre-commit hook.}
1235                         hook_failed_popup pre-commit $pch_error
1236                         unlock_index
1237                 } else {
1238                         commit_writetree $curHEAD $msg
1239                 }
1240                 set pch_error {}
1241                 return
1242         }
1243         fconfigure $fd_ph -blocking 0
1244 }
1245
1246 proc commit_writetree {curHEAD msg} {
1247         global ui_status_value
1248
1249         set ui_status_value {Committing changes...}
1250         set fd_wt [open "| git write-tree" r]
1251         fileevent $fd_wt readable \
1252                 [list commit_committree $fd_wt $curHEAD $msg]
1253 }
1254
1255 proc commit_committree {fd_wt curHEAD msg} {
1256         global HEAD PARENT MERGE_HEAD commit_type
1257         global all_heads current_branch
1258         global ui_status_value ui_comm selected_commit_type
1259         global file_states selected_paths rescan_active
1260         global repo_config
1261
1262         gets $fd_wt tree_id
1263         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1264                 error_popup "write-tree failed:\n\n$err"
1265                 set ui_status_value {Commit failed.}
1266                 unlock_index
1267                 return
1268         }
1269
1270         # -- Verify this wasn't an empty change.
1271         #
1272         if {$commit_type eq {normal}} {
1273                 set old_tree [git rev-parse "$PARENT^{tree}"]
1274                 if {$tree_id eq $old_tree} {
1275                         info_popup {No changes to commit.
1276
1277 No files were modified by this commit and it
1278 was not a merge commit.
1279
1280 A rescan will be automatically started now.
1281 }
1282                         unlock_index
1283                         rescan {set ui_status_value {No changes to commit.}}
1284                         return
1285                 }
1286         }
1287
1288         # -- Build the message.
1289         #
1290         set msg_p [gitdir COMMIT_EDITMSG]
1291         set msg_wt [open $msg_p w]
1292         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1293                 set enc utf-8
1294         }
1295         fconfigure $msg_wt -encoding $enc -translation binary
1296         puts -nonewline $msg_wt $msg
1297         close $msg_wt
1298
1299         # -- Create the commit.
1300         #
1301         set cmd [list git commit-tree $tree_id]
1302         foreach p [concat $PARENT $MERGE_HEAD] {
1303                 lappend cmd -p $p
1304         }
1305         lappend cmd <$msg_p
1306         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1307                 error_popup "commit-tree failed:\n\n$err"
1308                 set ui_status_value {Commit failed.}
1309                 unlock_index
1310                 return
1311         }
1312
1313         # -- Update the HEAD ref.
1314         #
1315         set reflogm commit
1316         if {$commit_type ne {normal}} {
1317                 append reflogm " ($commit_type)"
1318         }
1319         set i [string first "\n" $msg]
1320         if {$i >= 0} {
1321                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1322         } else {
1323                 append reflogm {: } $msg
1324         }
1325         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1326         if {[catch {eval exec $cmd} err]} {
1327                 error_popup "update-ref failed:\n\n$err"
1328                 set ui_status_value {Commit failed.}
1329                 unlock_index
1330                 return
1331         }
1332
1333         # -- Cleanup after ourselves.
1334         #
1335         catch {file delete $msg_p}
1336         catch {file delete [gitdir MERGE_HEAD]}
1337         catch {file delete [gitdir MERGE_MSG]}
1338         catch {file delete [gitdir SQUASH_MSG]}
1339         catch {file delete [gitdir GITGUI_MSG]}
1340
1341         # -- Let rerere do its thing.
1342         #
1343         if {[file isdirectory [gitdir rr-cache]]} {
1344                 catch {git rerere}
1345         }
1346
1347         # -- Run the post-commit hook.
1348         #
1349         set pchook [gitdir hooks post-commit]
1350         if {[is_Cygwin] && [file isfile $pchook]} {
1351                 set pchook [list sh -c [concat \
1352                         "if test -x \"$pchook\";" \
1353                         "then exec \"$pchook\";" \
1354                         "fi"]]
1355         } elseif {![file executable $pchook]} {
1356                 set pchook {}
1357         }
1358         if {$pchook ne {}} {
1359                 catch {exec $pchook &}
1360         }
1361
1362         $ui_comm delete 0.0 end
1363         $ui_comm edit reset
1364         $ui_comm edit modified false
1365
1366         if {[is_enabled singlecommit]} do_quit
1367
1368         # -- Make sure our current branch exists.
1369         #
1370         if {$commit_type eq {initial}} {
1371                 lappend all_heads $current_branch
1372                 set all_heads [lsort -unique $all_heads]
1373                 populate_branch_menu
1374         }
1375
1376         # -- Update in memory status
1377         #
1378         set selected_commit_type new
1379         set commit_type normal
1380         set HEAD $cmt_id
1381         set PARENT $cmt_id
1382         set MERGE_HEAD [list]
1383
1384         foreach path [array names file_states] {
1385                 set s $file_states($path)
1386                 set m [lindex $s 0]
1387                 switch -glob -- $m {
1388                 _O -
1389                 _M -
1390                 _D {continue}
1391                 __ -
1392                 A_ -
1393                 M_ -
1394                 D_ {
1395                         unset file_states($path)
1396                         catch {unset selected_paths($path)}
1397                 }
1398                 DO {
1399                         set file_states($path) [list _O [lindex $s 1] {} {}]
1400                 }
1401                 AM -
1402                 AD -
1403                 MM -
1404                 MD {
1405                         set file_states($path) [list \
1406                                 _[string index $m 1] \
1407                                 [lindex $s 1] \
1408                                 [lindex $s 3] \
1409                                 {}]
1410                 }
1411                 }
1412         }
1413
1414         display_all_files
1415         unlock_index
1416         reshow_diff
1417         set ui_status_value \
1418                 "Changes committed as [string range $cmt_id 0 7]."
1419 }
1420
1421 ######################################################################
1422 ##
1423 ## fetch push
1424
1425 proc fetch_from {remote} {
1426         set w [new_console \
1427                 "fetch $remote" \
1428                 "Fetching new changes from $remote"]
1429         set cmd [list git fetch]
1430         lappend cmd $remote
1431         console_exec $w $cmd console_done
1432 }
1433
1434 proc push_to {remote} {
1435         set w [new_console \
1436                 "push $remote" \
1437                 "Pushing changes to $remote"]
1438         set cmd [list git push]
1439         lappend cmd -v
1440         lappend cmd $remote
1441         console_exec $w $cmd console_done
1442 }
1443
1444 ######################################################################
1445 ##
1446 ## ui helpers
1447
1448 proc mapicon {w state path} {
1449         global all_icons
1450
1451         if {[catch {set r $all_icons($state$w)}]} {
1452                 puts "error: no icon for $w state={$state} $path"
1453                 return file_plain
1454         }
1455         return $r
1456 }
1457
1458 proc mapdesc {state path} {
1459         global all_descs
1460
1461         if {[catch {set r $all_descs($state)}]} {
1462                 puts "error: no desc for state={$state} $path"
1463                 return $state
1464         }
1465         return $r
1466 }
1467
1468 proc escape_path {path} {
1469         regsub -all {\\} $path "\\\\" path
1470         regsub -all "\n" $path "\\n" path
1471         return $path
1472 }
1473
1474 proc short_path {path} {
1475         return [escape_path [lindex [file split $path] end]]
1476 }
1477
1478 set next_icon_id 0
1479 set null_sha1 [string repeat 0 40]
1480
1481 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1482         global file_states next_icon_id null_sha1
1483
1484         set s0 [string index $new_state 0]
1485         set s1 [string index $new_state 1]
1486
1487         if {[catch {set info $file_states($path)}]} {
1488                 set state __
1489                 set icon n[incr next_icon_id]
1490         } else {
1491                 set state [lindex $info 0]
1492                 set icon [lindex $info 1]
1493                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1494                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1495         }
1496
1497         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1498         elseif {$s0 eq {_}} {set s0 _}
1499
1500         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1501         elseif {$s1 eq {_}} {set s1 _}
1502
1503         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1504                 set head_info [list 0 $null_sha1]
1505         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1506                 && $head_info eq {}} {
1507                 set head_info $index_info
1508         }
1509
1510         set file_states($path) [list $s0$s1 $icon \
1511                 $head_info $index_info \
1512                 ]
1513         return $state
1514 }
1515
1516 proc display_file_helper {w path icon_name old_m new_m} {
1517         global file_lists
1518
1519         if {$new_m eq {_}} {
1520                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1521                 if {$lno >= 0} {
1522                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1523                         incr lno
1524                         $w conf -state normal
1525                         $w delete $lno.0 [expr {$lno + 1}].0
1526                         $w conf -state disabled
1527                 }
1528         } elseif {$old_m eq {_} && $new_m ne {_}} {
1529                 lappend file_lists($w) $path
1530                 set file_lists($w) [lsort -unique $file_lists($w)]
1531                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1532                 incr lno
1533                 $w conf -state normal
1534                 $w image create $lno.0 \
1535                         -align center -padx 5 -pady 1 \
1536                         -name $icon_name \
1537                         -image [mapicon $w $new_m $path]
1538                 $w insert $lno.1 "[escape_path $path]\n"
1539                 $w conf -state disabled
1540         } elseif {$old_m ne $new_m} {
1541                 $w conf -state normal
1542                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1543                 $w conf -state disabled
1544         }
1545 }
1546
1547 proc display_file {path state} {
1548         global file_states selected_paths
1549         global ui_index ui_workdir
1550
1551         set old_m [merge_state $path $state]
1552         set s $file_states($path)
1553         set new_m [lindex $s 0]
1554         set icon_name [lindex $s 1]
1555
1556         set o [string index $old_m 0]
1557         set n [string index $new_m 0]
1558         if {$o eq {U}} {
1559                 set o _
1560         }
1561         if {$n eq {U}} {
1562                 set n _
1563         }
1564         display_file_helper     $ui_index $path $icon_name $o $n
1565
1566         if {[string index $old_m 0] eq {U}} {
1567                 set o U
1568         } else {
1569                 set o [string index $old_m 1]
1570         }
1571         if {[string index $new_m 0] eq {U}} {
1572                 set n U
1573         } else {
1574                 set n [string index $new_m 1]
1575         }
1576         display_file_helper     $ui_workdir $path $icon_name $o $n
1577
1578         if {$new_m eq {__}} {
1579                 unset file_states($path)
1580                 catch {unset selected_paths($path)}
1581         }
1582 }
1583
1584 proc display_all_files_helper {w path icon_name m} {
1585         global file_lists
1586
1587         lappend file_lists($w) $path
1588         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1589         $w image create end \
1590                 -align center -padx 5 -pady 1 \
1591                 -name $icon_name \
1592                 -image [mapicon $w $m $path]
1593         $w insert end "[escape_path $path]\n"
1594 }
1595
1596 proc display_all_files {} {
1597         global ui_index ui_workdir
1598         global file_states file_lists
1599         global last_clicked
1600
1601         $ui_index conf -state normal
1602         $ui_workdir conf -state normal
1603
1604         $ui_index delete 0.0 end
1605         $ui_workdir delete 0.0 end
1606         set last_clicked {}
1607
1608         set file_lists($ui_index) [list]
1609         set file_lists($ui_workdir) [list]
1610
1611         foreach path [lsort [array names file_states]] {
1612                 set s $file_states($path)
1613                 set m [lindex $s 0]
1614                 set icon_name [lindex $s 1]
1615
1616                 set s [string index $m 0]
1617                 if {$s ne {U} && $s ne {_}} {
1618                         display_all_files_helper $ui_index $path \
1619                                 $icon_name $s
1620                 }
1621
1622                 if {[string index $m 0] eq {U}} {
1623                         set s U
1624                 } else {
1625                         set s [string index $m 1]
1626                 }
1627                 if {$s ne {_}} {
1628                         display_all_files_helper $ui_workdir $path \
1629                                 $icon_name $s
1630                 }
1631         }
1632
1633         $ui_index conf -state disabled
1634         $ui_workdir conf -state disabled
1635 }
1636
1637 proc update_indexinfo {msg pathList after} {
1638         global update_index_cp ui_status_value
1639
1640         if {![lock_index update]} return
1641
1642         set update_index_cp 0
1643         set pathList [lsort $pathList]
1644         set totalCnt [llength $pathList]
1645         set batch [expr {int($totalCnt * .01) + 1}]
1646         if {$batch > 25} {set batch 25}
1647
1648         set ui_status_value [format \
1649                 "$msg... %i/%i files (%.2f%%)" \
1650                 $update_index_cp \
1651                 $totalCnt \
1652                 0.0]
1653         set fd [open "| git update-index -z --index-info" w]
1654         fconfigure $fd \
1655                 -blocking 0 \
1656                 -buffering full \
1657                 -buffersize 512 \
1658                 -encoding binary \
1659                 -translation binary
1660         fileevent $fd writable [list \
1661                 write_update_indexinfo \
1662                 $fd \
1663                 $pathList \
1664                 $totalCnt \
1665                 $batch \
1666                 $msg \
1667                 $after \
1668                 ]
1669 }
1670
1671 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1672         global update_index_cp ui_status_value
1673         global file_states current_diff_path
1674
1675         if {$update_index_cp >= $totalCnt} {
1676                 close $fd
1677                 unlock_index
1678                 uplevel #0 $after
1679                 return
1680         }
1681
1682         for {set i $batch} \
1683                 {$update_index_cp < $totalCnt && $i > 0} \
1684                 {incr i -1} {
1685                 set path [lindex $pathList $update_index_cp]
1686                 incr update_index_cp
1687
1688                 set s $file_states($path)
1689                 switch -glob -- [lindex $s 0] {
1690                 A? {set new _O}
1691                 M? {set new _M}
1692                 D_ {set new _D}
1693                 D? {set new _?}
1694                 ?? {continue}
1695                 }
1696                 set info [lindex $s 2]
1697                 if {$info eq {}} continue
1698
1699                 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1700                 display_file $path $new
1701         }
1702
1703         set ui_status_value [format \
1704                 "$msg... %i/%i files (%.2f%%)" \
1705                 $update_index_cp \
1706                 $totalCnt \
1707                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1708 }
1709
1710 proc update_index {msg pathList after} {
1711         global update_index_cp ui_status_value
1712
1713         if {![lock_index update]} return
1714
1715         set update_index_cp 0
1716         set pathList [lsort $pathList]
1717         set totalCnt [llength $pathList]
1718         set batch [expr {int($totalCnt * .01) + 1}]
1719         if {$batch > 25} {set batch 25}
1720
1721         set ui_status_value [format \
1722                 "$msg... %i/%i files (%.2f%%)" \
1723                 $update_index_cp \
1724                 $totalCnt \
1725                 0.0]
1726         set fd [open "| git update-index --add --remove -z --stdin" w]
1727         fconfigure $fd \
1728                 -blocking 0 \
1729                 -buffering full \
1730                 -buffersize 512 \
1731                 -encoding binary \
1732                 -translation binary
1733         fileevent $fd writable [list \
1734                 write_update_index \
1735                 $fd \
1736                 $pathList \
1737                 $totalCnt \
1738                 $batch \
1739                 $msg \
1740                 $after \
1741                 ]
1742 }
1743
1744 proc write_update_index {fd pathList totalCnt batch msg after} {
1745         global update_index_cp ui_status_value
1746         global file_states current_diff_path
1747
1748         if {$update_index_cp >= $totalCnt} {
1749                 close $fd
1750                 unlock_index
1751                 uplevel #0 $after
1752                 return
1753         }
1754
1755         for {set i $batch} \
1756                 {$update_index_cp < $totalCnt && $i > 0} \
1757                 {incr i -1} {
1758                 set path [lindex $pathList $update_index_cp]
1759                 incr update_index_cp
1760
1761                 switch -glob -- [lindex $file_states($path) 0] {
1762                 AD {set new __}
1763                 ?D {set new D_}
1764                 _O -
1765                 AM {set new A_}
1766                 U? {
1767                         if {[file exists $path]} {
1768                                 set new M_
1769                         } else {
1770                                 set new D_
1771                         }
1772                 }
1773                 ?M {set new M_}
1774                 ?? {continue}
1775                 }
1776                 puts -nonewline $fd "[encoding convertto $path]\0"
1777                 display_file $path $new
1778         }
1779
1780         set ui_status_value [format \
1781                 "$msg... %i/%i files (%.2f%%)" \
1782                 $update_index_cp \
1783                 $totalCnt \
1784                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1785 }
1786
1787 proc checkout_index {msg pathList after} {
1788         global update_index_cp ui_status_value
1789
1790         if {![lock_index update]} return
1791
1792         set update_index_cp 0
1793         set pathList [lsort $pathList]
1794         set totalCnt [llength $pathList]
1795         set batch [expr {int($totalCnt * .01) + 1}]
1796         if {$batch > 25} {set batch 25}
1797
1798         set ui_status_value [format \
1799                 "$msg... %i/%i files (%.2f%%)" \
1800                 $update_index_cp \
1801                 $totalCnt \
1802                 0.0]
1803         set cmd [list git checkout-index]
1804         lappend cmd --index
1805         lappend cmd --quiet
1806         lappend cmd --force
1807         lappend cmd -z
1808         lappend cmd --stdin
1809         set fd [open "| $cmd " w]
1810         fconfigure $fd \
1811                 -blocking 0 \
1812                 -buffering full \
1813                 -buffersize 512 \
1814                 -encoding binary \
1815                 -translation binary
1816         fileevent $fd writable [list \
1817                 write_checkout_index \
1818                 $fd \
1819                 $pathList \
1820                 $totalCnt \
1821                 $batch \
1822                 $msg \
1823                 $after \
1824                 ]
1825 }
1826
1827 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1828         global update_index_cp ui_status_value
1829         global file_states current_diff_path
1830
1831         if {$update_index_cp >= $totalCnt} {
1832                 close $fd
1833                 unlock_index
1834                 uplevel #0 $after
1835                 return
1836         }
1837
1838         for {set i $batch} \
1839                 {$update_index_cp < $totalCnt && $i > 0} \
1840                 {incr i -1} {
1841                 set path [lindex $pathList $update_index_cp]
1842                 incr update_index_cp
1843                 switch -glob -- [lindex $file_states($path) 0] {
1844                 U? {continue}
1845                 ?M -
1846                 ?D {
1847                         puts -nonewline $fd "[encoding convertto $path]\0"
1848                         display_file $path ?_
1849                 }
1850                 }
1851         }
1852
1853         set ui_status_value [format \
1854                 "$msg... %i/%i files (%.2f%%)" \
1855                 $update_index_cp \
1856                 $totalCnt \
1857                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1858 }
1859
1860 ######################################################################
1861 ##
1862 ## branch management
1863
1864 proc is_tracking_branch {name} {
1865         global tracking_branches
1866
1867         if {![catch {set info $tracking_branches($name)}]} {
1868                 return 1
1869         }
1870         foreach t [array names tracking_branches] {
1871                 if {[string match {*/\*} $t] && [string match $t $name]} {
1872                         return 1
1873                 }
1874         }
1875         return 0
1876 }
1877
1878 proc load_all_heads {} {
1879         global all_heads
1880
1881         set all_heads [list]
1882         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1883         while {[gets $fd line] > 0} {
1884                 if {[is_tracking_branch $line]} continue
1885                 if {![regsub ^refs/heads/ $line {} name]} continue
1886                 lappend all_heads $name
1887         }
1888         close $fd
1889
1890         set all_heads [lsort $all_heads]
1891 }
1892
1893 proc populate_branch_menu {} {
1894         global all_heads disable_on_lock
1895
1896         set m .mbar.branch
1897         set last [$m index last]
1898         for {set i 0} {$i <= $last} {incr i} {
1899                 if {[$m type $i] eq {separator}} {
1900                         $m delete $i last
1901                         set new_dol [list]
1902                         foreach a $disable_on_lock {
1903                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1904                                         lappend new_dol $a
1905                                 }
1906                         }
1907                         set disable_on_lock $new_dol
1908                         break
1909                 }
1910         }
1911
1912         if {$all_heads ne {}} {
1913                 $m add separator
1914         }
1915         foreach b $all_heads {
1916                 $m add radiobutton \
1917                         -label $b \
1918                         -command [list switch_branch $b] \
1919                         -variable current_branch \
1920                         -value $b \
1921                         -font font_ui
1922                 lappend disable_on_lock \
1923                         [list $m entryconf [$m index last] -state]
1924         }
1925 }
1926
1927 proc all_tracking_branches {} {
1928         global tracking_branches
1929
1930         set all_trackings {}
1931         set cmd {}
1932         foreach name [array names tracking_branches] {
1933                 if {[regsub {/\*$} $name {} name]} {
1934                         lappend cmd $name
1935                 } else {
1936                         regsub ^refs/(heads|remotes)/ $name {} name
1937                         lappend all_trackings $name
1938                 }
1939         }
1940
1941         if {$cmd ne {}} {
1942                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1943                 while {[gets $fd name] > 0} {
1944                         regsub ^refs/(heads|remotes)/ $name {} name
1945                         lappend all_trackings $name
1946                 }
1947                 close $fd
1948         }
1949
1950         return [lsort -unique $all_trackings]
1951 }
1952
1953 proc load_all_tags {} {
1954         set all_tags [list]
1955         set fd [open "| git for-each-ref --format=%(refname) refs/tags" r]
1956         while {[gets $fd line] > 0} {
1957                 if {![regsub ^refs/tags/ $line {} name]} continue
1958                 lappend all_tags $name
1959         }
1960         close $fd
1961
1962         return [lsort $all_tags]
1963 }
1964
1965 proc do_create_branch_action {w} {
1966         global all_heads null_sha1 repo_config
1967         global create_branch_checkout create_branch_revtype
1968         global create_branch_head create_branch_trackinghead
1969         global create_branch_name create_branch_revexp
1970         global create_branch_tag
1971
1972         set newbranch $create_branch_name
1973         if {$newbranch eq {}
1974                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1975                 tk_messageBox \
1976                         -icon error \
1977                         -type ok \
1978                         -title [wm title $w] \
1979                         -parent $w \
1980                         -message "Please supply a branch name."
1981                 focus $w.desc.name_t
1982                 return
1983         }
1984         if {![catch {git show-ref --verify -- "refs/heads/$newbranch"}]} {
1985                 tk_messageBox \
1986                         -icon error \
1987                         -type ok \
1988                         -title [wm title $w] \
1989                         -parent $w \
1990                         -message "Branch '$newbranch' already exists."
1991                 focus $w.desc.name_t
1992                 return
1993         }
1994         if {[catch {git check-ref-format "heads/$newbranch"}]} {
1995                 tk_messageBox \
1996                         -icon error \
1997                         -type ok \
1998                         -title [wm title $w] \
1999                         -parent $w \
2000                         -message "We do not like '$newbranch' as a branch name."
2001                 focus $w.desc.name_t
2002                 return
2003         }
2004
2005         set rev {}
2006         switch -- $create_branch_revtype {
2007         head {set rev $create_branch_head}
2008         tracking {set rev $create_branch_trackinghead}
2009         tag {set rev $create_branch_tag}
2010         expression {set rev $create_branch_revexp}
2011         }
2012         if {[catch {set cmt [git rev-parse --verify "${rev}^0"]}]} {
2013                 tk_messageBox \
2014                         -icon error \
2015                         -type ok \
2016                         -title [wm title $w] \
2017                         -parent $w \
2018                         -message "Invalid starting revision: $rev"
2019                 return
2020         }
2021         set cmd [list git update-ref]
2022         lappend cmd -m
2023         lappend cmd "branch: Created from $rev"
2024         lappend cmd "refs/heads/$newbranch"
2025         lappend cmd $cmt
2026         lappend cmd $null_sha1
2027         if {[catch {eval exec $cmd} err]} {
2028                 tk_messageBox \
2029                         -icon error \
2030                         -type ok \
2031                         -title [wm title $w] \
2032                         -parent $w \
2033                         -message "Failed to create '$newbranch'.\n\n$err"
2034                 return
2035         }
2036
2037         lappend all_heads $newbranch
2038         set all_heads [lsort $all_heads]
2039         populate_branch_menu
2040         destroy $w
2041         if {$create_branch_checkout} {
2042                 switch_branch $newbranch
2043         }
2044 }
2045
2046 proc radio_selector {varname value args} {
2047         upvar #0 $varname var
2048         set var $value
2049 }
2050
2051 trace add variable create_branch_head write \
2052         [list radio_selector create_branch_revtype head]
2053 trace add variable create_branch_trackinghead write \
2054         [list radio_selector create_branch_revtype tracking]
2055 trace add variable create_branch_tag write \
2056         [list radio_selector create_branch_revtype tag]
2057
2058 trace add variable delete_branch_head write \
2059         [list radio_selector delete_branch_checktype head]
2060 trace add variable delete_branch_trackinghead write \
2061         [list radio_selector delete_branch_checktype tracking]
2062
2063 proc do_create_branch {} {
2064         global all_heads current_branch repo_config
2065         global create_branch_checkout create_branch_revtype
2066         global create_branch_head create_branch_trackinghead
2067         global create_branch_name create_branch_revexp
2068         global create_branch_tag
2069
2070         set w .branch_editor
2071         toplevel $w
2072         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2073
2074         label $w.header -text {Create New Branch} \
2075                 -font font_uibold
2076         pack $w.header -side top -fill x
2077
2078         frame $w.buttons
2079         button $w.buttons.create -text Create \
2080                 -font font_ui \
2081                 -default active \
2082                 -command [list do_create_branch_action $w]
2083         pack $w.buttons.create -side right
2084         button $w.buttons.cancel -text {Cancel} \
2085                 -font font_ui \
2086                 -command [list destroy $w]
2087         pack $w.buttons.cancel -side right -padx 5
2088         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2089
2090         labelframe $w.desc \
2091                 -text {Branch Description} \
2092                 -font font_ui
2093         label $w.desc.name_l -text {Name:} -font font_ui
2094         entry $w.desc.name_t \
2095                 -borderwidth 1 \
2096                 -relief sunken \
2097                 -width 40 \
2098                 -textvariable create_branch_name \
2099                 -font font_ui \
2100                 -validate key \
2101                 -validatecommand {
2102                         if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2103                         return 1
2104                 }
2105         grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2106         grid columnconfigure $w.desc 1 -weight 1
2107         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2108
2109         labelframe $w.from \
2110                 -text {Starting Revision} \
2111                 -font font_ui
2112         radiobutton $w.from.head_r \
2113                 -text {Local Branch:} \
2114                 -value head \
2115                 -variable create_branch_revtype \
2116                 -font font_ui
2117         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2118         grid $w.from.head_r $w.from.head_m -sticky w
2119         set all_trackings [all_tracking_branches]
2120         if {$all_trackings ne {}} {
2121                 set create_branch_trackinghead [lindex $all_trackings 0]
2122                 radiobutton $w.from.tracking_r \
2123                         -text {Tracking Branch:} \
2124                         -value tracking \
2125                         -variable create_branch_revtype \
2126                         -font font_ui
2127                 eval tk_optionMenu $w.from.tracking_m \
2128                         create_branch_trackinghead \
2129                         $all_trackings
2130                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2131         }
2132         set all_tags [load_all_tags]
2133         if {$all_tags ne {}} {
2134                 set create_branch_tag [lindex $all_tags 0]
2135                 radiobutton $w.from.tag_r \
2136                         -text {Tag:} \
2137                         -value tag \
2138                         -variable create_branch_revtype \
2139                         -font font_ui
2140                 eval tk_optionMenu $w.from.tag_m \
2141                         create_branch_tag \
2142                         $all_tags
2143                 grid $w.from.tag_r $w.from.tag_m -sticky w
2144         }
2145         radiobutton $w.from.exp_r \
2146                 -text {Revision Expression:} \
2147                 -value expression \
2148                 -variable create_branch_revtype \
2149                 -font font_ui
2150         entry $w.from.exp_t \
2151                 -borderwidth 1 \
2152                 -relief sunken \
2153                 -width 50 \
2154                 -textvariable create_branch_revexp \
2155                 -font font_ui \
2156                 -validate key \
2157                 -validatecommand {
2158                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2159                         if {%d == 1 && [string length %S] > 0} {
2160                                 set create_branch_revtype expression
2161                         }
2162                         return 1
2163                 }
2164         grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2165         grid columnconfigure $w.from 1 -weight 1
2166         pack $w.from -anchor nw -fill x -pady 5 -padx 5
2167
2168         labelframe $w.postActions \
2169                 -text {Post Creation Actions} \
2170                 -font font_ui
2171         checkbutton $w.postActions.checkout \
2172                 -text {Checkout after creation} \
2173                 -variable create_branch_checkout \
2174                 -font font_ui
2175         pack $w.postActions.checkout -anchor nw
2176         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2177
2178         set create_branch_checkout 1
2179         set create_branch_head $current_branch
2180         set create_branch_revtype head
2181         set create_branch_name $repo_config(gui.newbranchtemplate)
2182         set create_branch_revexp {}
2183
2184         bind $w <Visibility> "
2185                 grab $w
2186                 $w.desc.name_t icursor end
2187                 focus $w.desc.name_t
2188         "
2189         bind $w <Key-Escape> "destroy $w"
2190         bind $w <Key-Return> "do_create_branch_action $w;break"
2191         wm title $w "[appname] ([reponame]): Create Branch"
2192         tkwait window $w
2193 }
2194
2195 proc do_delete_branch_action {w} {
2196         global all_heads
2197         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2198
2199         set check_rev {}
2200         switch -- $delete_branch_checktype {
2201         head {set check_rev $delete_branch_head}
2202         tracking {set check_rev $delete_branch_trackinghead}
2203         always {set check_rev {:none}}
2204         }
2205         if {$check_rev eq {:none}} {
2206                 set check_cmt {}
2207         } elseif {[catch {set check_cmt [git rev-parse --verify "${check_rev}^0"]}]} {
2208                 tk_messageBox \
2209                         -icon error \
2210                         -type ok \
2211                         -title [wm title $w] \
2212                         -parent $w \
2213                         -message "Invalid check revision: $check_rev"
2214                 return
2215         }
2216
2217         set to_delete [list]
2218         set not_merged [list]
2219         foreach i [$w.list.l curselection] {
2220                 set b [$w.list.l get $i]
2221                 if {[catch {set o [git rev-parse --verify $b]}]} continue
2222                 if {$check_cmt ne {}} {
2223                         if {$b eq $check_rev} continue
2224                         if {[catch {set m [git merge-base $o $check_cmt]}]} continue
2225                         if {$o ne $m} {
2226                                 lappend not_merged $b
2227                                 continue
2228                         }
2229                 }
2230                 lappend to_delete [list $b $o]
2231         }
2232         if {$not_merged ne {}} {
2233                 set msg "The following branches are not completely merged into $check_rev:
2234
2235  - [join $not_merged "\n - "]"
2236                 tk_messageBox \
2237                         -icon info \
2238                         -type ok \
2239                         -title [wm title $w] \
2240                         -parent $w \
2241                         -message $msg
2242         }
2243         if {$to_delete eq {}} return
2244         if {$delete_branch_checktype eq {always}} {
2245                 set msg {Recovering deleted branches is difficult.
2246
2247 Delete the selected branches?}
2248                 if {[tk_messageBox \
2249                         -icon warning \
2250                         -type yesno \
2251                         -title [wm title $w] \
2252                         -parent $w \
2253                         -message $msg] ne yes} {
2254                         return
2255                 }
2256         }
2257
2258         set failed {}
2259         foreach i $to_delete {
2260                 set b [lindex $i 0]
2261                 set o [lindex $i 1]
2262                 if {[catch {git update-ref -d "refs/heads/$b" $o} err]} {
2263                         append failed " - $b: $err\n"
2264                 } else {
2265                         set x [lsearch -sorted -exact $all_heads $b]
2266                         if {$x >= 0} {
2267                                 set all_heads [lreplace $all_heads $x $x]
2268                         }
2269                 }
2270         }
2271
2272         if {$failed ne {}} {
2273                 tk_messageBox \
2274                         -icon error \
2275                         -type ok \
2276                         -title [wm title $w] \
2277                         -parent $w \
2278                         -message "Failed to delete branches:\n$failed"
2279         }
2280
2281         set all_heads [lsort $all_heads]
2282         populate_branch_menu
2283         destroy $w
2284 }
2285
2286 proc do_delete_branch {} {
2287         global all_heads tracking_branches current_branch
2288         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2289
2290         set w .branch_editor
2291         toplevel $w
2292         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2293
2294         label $w.header -text {Delete Local Branch} \
2295                 -font font_uibold
2296         pack $w.header -side top -fill x
2297
2298         frame $w.buttons
2299         button $w.buttons.create -text Delete \
2300                 -font font_ui \
2301                 -command [list do_delete_branch_action $w]
2302         pack $w.buttons.create -side right
2303         button $w.buttons.cancel -text {Cancel} \
2304                 -font font_ui \
2305                 -command [list destroy $w]
2306         pack $w.buttons.cancel -side right -padx 5
2307         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2308
2309         labelframe $w.list \
2310                 -text {Local Branches} \
2311                 -font font_ui
2312         listbox $w.list.l \
2313                 -height 10 \
2314                 -width 70 \
2315                 -selectmode extended \
2316                 -yscrollcommand [list $w.list.sby set] \
2317                 -font font_ui
2318         foreach h $all_heads {
2319                 if {$h ne $current_branch} {
2320                         $w.list.l insert end $h
2321                 }
2322         }
2323         scrollbar $w.list.sby -command [list $w.list.l yview]
2324         pack $w.list.sby -side right -fill y
2325         pack $w.list.l -side left -fill both -expand 1
2326         pack $w.list -fill both -expand 1 -pady 5 -padx 5
2327
2328         labelframe $w.validate \
2329                 -text {Delete Only If} \
2330                 -font font_ui
2331         radiobutton $w.validate.head_r \
2332                 -text {Merged Into Local Branch:} \
2333                 -value head \
2334                 -variable delete_branch_checktype \
2335                 -font font_ui
2336         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2337         grid $w.validate.head_r $w.validate.head_m -sticky w
2338         set all_trackings [all_tracking_branches]
2339         if {$all_trackings ne {}} {
2340                 set delete_branch_trackinghead [lindex $all_trackings 0]
2341                 radiobutton $w.validate.tracking_r \
2342                         -text {Merged Into Tracking Branch:} \
2343                         -value tracking \
2344                         -variable delete_branch_checktype \
2345                         -font font_ui
2346                 eval tk_optionMenu $w.validate.tracking_m \
2347                         delete_branch_trackinghead \
2348                         $all_trackings
2349                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2350         }
2351         radiobutton $w.validate.always_r \
2352                 -text {Always (Do not perform merge checks)} \
2353                 -value always \
2354                 -variable delete_branch_checktype \
2355                 -font font_ui
2356         grid $w.validate.always_r -columnspan 2 -sticky w
2357         grid columnconfigure $w.validate 1 -weight 1
2358         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2359
2360         set delete_branch_head $current_branch
2361         set delete_branch_checktype head
2362
2363         bind $w <Visibility> "grab $w; focus $w"
2364         bind $w <Key-Escape> "destroy $w"
2365         wm title $w "[appname] ([reponame]): Delete Branch"
2366         tkwait window $w
2367 }
2368
2369 proc switch_branch {new_branch} {
2370         global HEAD commit_type current_branch repo_config
2371
2372         if {![lock_index switch]} return
2373
2374         # -- Our in memory state should match the repository.
2375         #
2376         repository_state curType curHEAD curMERGE_HEAD
2377         if {[string match amend* $commit_type]
2378                 && $curType eq {normal}
2379                 && $curHEAD eq $HEAD} {
2380         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2381                 info_popup {Last scanned state does not match repository state.
2382
2383 Another Git program has modified this repository
2384 since the last scan.  A rescan must be performed
2385 before the current branch can be changed.
2386
2387 The rescan will be automatically started now.
2388 }
2389                 unlock_index
2390                 rescan {set ui_status_value {Ready.}}
2391                 return
2392         }
2393
2394         # -- Don't do a pointless switch.
2395         #
2396         if {$current_branch eq $new_branch} {
2397                 unlock_index
2398                 return
2399         }
2400
2401         if {$repo_config(gui.trustmtime) eq {true}} {
2402                 switch_branch_stage2 {} $new_branch
2403         } else {
2404                 set ui_status_value {Refreshing file status...}
2405                 set cmd [list git update-index]
2406                 lappend cmd -q
2407                 lappend cmd --unmerged
2408                 lappend cmd --ignore-missing
2409                 lappend cmd --refresh
2410                 set fd_rf [open "| $cmd" r]
2411                 fconfigure $fd_rf -blocking 0 -translation binary
2412                 fileevent $fd_rf readable \
2413                         [list switch_branch_stage2 $fd_rf $new_branch]
2414         }
2415 }
2416
2417 proc switch_branch_stage2 {fd_rf new_branch} {
2418         global ui_status_value HEAD
2419
2420         if {$fd_rf ne {}} {
2421                 read $fd_rf
2422                 if {![eof $fd_rf]} return
2423                 close $fd_rf
2424         }
2425
2426         set ui_status_value "Updating working directory to '$new_branch'..."
2427         set cmd [list git read-tree]
2428         lappend cmd -m
2429         lappend cmd -u
2430         lappend cmd --exclude-per-directory=.gitignore
2431         lappend cmd $HEAD
2432         lappend cmd $new_branch
2433         set fd_rt [open "| $cmd" r]
2434         fconfigure $fd_rt -blocking 0 -translation binary
2435         fileevent $fd_rt readable \
2436                 [list switch_branch_readtree_wait $fd_rt $new_branch]
2437 }
2438
2439 proc switch_branch_readtree_wait {fd_rt new_branch} {
2440         global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2441         global current_branch
2442         global ui_comm ui_status_value
2443
2444         # -- We never get interesting output on stdout; only stderr.
2445         #
2446         read $fd_rt
2447         fconfigure $fd_rt -blocking 1
2448         if {![eof $fd_rt]} {
2449                 fconfigure $fd_rt -blocking 0
2450                 return
2451         }
2452
2453         # -- The working directory wasn't in sync with the index and
2454         #    we'd have to overwrite something to make the switch. A
2455         #    merge is required.
2456         #
2457         if {[catch {close $fd_rt} err]} {
2458                 regsub {^fatal: } $err {} err
2459                 warn_popup "File level merge required.
2460
2461 $err
2462
2463 Staying on branch '$current_branch'."
2464                 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2465                 unlock_index
2466                 return
2467         }
2468
2469         # -- Update the symbolic ref.  Core git doesn't even check for failure
2470         #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2471         #    state that is difficult to recover from within git-gui.
2472         #
2473         if {[catch {git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2474                 error_popup "Failed to set current branch.
2475
2476 This working directory is only partially switched.
2477 We successfully updated your files, but failed to
2478 update an internal Git file.
2479
2480 This should not have occurred.  [appname] will now
2481 close and give up.
2482
2483 $err"
2484                 do_quit
2485                 return
2486         }
2487
2488         # -- Update our repository state.  If we were previously in amend mode
2489         #    we need to toss the current buffer and do a full rescan to update
2490         #    our file lists.  If we weren't in amend mode our file lists are
2491         #    accurate and we can avoid the rescan.
2492         #
2493         unlock_index
2494         set selected_commit_type new
2495         if {[string match amend* $commit_type]} {
2496                 $ui_comm delete 0.0 end
2497                 $ui_comm edit reset
2498                 $ui_comm edit modified false
2499                 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2500         } else {
2501                 repository_state commit_type HEAD MERGE_HEAD
2502                 set PARENT $HEAD
2503                 set ui_status_value "Checked out branch '$current_branch'."
2504         }
2505 }
2506
2507 ######################################################################
2508 ##
2509 ## remote management
2510
2511 proc load_all_remotes {} {
2512         global repo_config
2513         global all_remotes tracking_branches
2514
2515         set all_remotes [list]
2516         array unset tracking_branches
2517
2518         set rm_dir [gitdir remotes]
2519         if {[file isdirectory $rm_dir]} {
2520                 set all_remotes [glob \
2521                         -types f \
2522                         -tails \
2523                         -nocomplain \
2524                         -directory $rm_dir *]
2525
2526                 foreach name $all_remotes {
2527                         catch {
2528                                 set fd [open [file join $rm_dir $name] r]
2529                                 while {[gets $fd line] >= 0} {
2530                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2531                                                 $line line src dst]} continue
2532                                         if {![regexp ^refs/ $dst]} {
2533                                                 set dst "refs/heads/$dst"
2534                                         }
2535                                         set tracking_branches($dst) [list $name $src]
2536                                 }
2537                                 close $fd
2538                         }
2539                 }
2540         }
2541
2542         foreach line [array names repo_config remote.*.url] {
2543                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2544                 lappend all_remotes $name
2545
2546                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2547                         set fl {}
2548                 }
2549                 foreach line $fl {
2550                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2551                         if {![regexp ^refs/ $dst]} {
2552                                 set dst "refs/heads/$dst"
2553                         }
2554                         set tracking_branches($dst) [list $name $src]
2555                 }
2556         }
2557
2558         set all_remotes [lsort -unique $all_remotes]
2559 }
2560
2561 proc populate_fetch_menu {} {
2562         global all_remotes repo_config
2563
2564         set m .mbar.fetch
2565         foreach r $all_remotes {
2566                 set enable 0
2567                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2568                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2569                                 set enable 1
2570                         }
2571                 } else {
2572                         catch {
2573                                 set fd [open [gitdir remotes $r] r]
2574                                 while {[gets $fd n] >= 0} {
2575                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2576                                                 set enable 1
2577                                                 break
2578                                         }
2579                                 }
2580                                 close $fd
2581                         }
2582                 }
2583
2584                 if {$enable} {
2585                         $m add command \
2586                                 -label "Fetch from $r..." \
2587                                 -command [list fetch_from $r] \
2588                                 -font font_ui
2589                 }
2590         }
2591 }
2592
2593 proc populate_push_menu {} {
2594         global all_remotes repo_config
2595
2596         set m .mbar.push
2597         set fast_count 0
2598         foreach r $all_remotes {
2599                 set enable 0
2600                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2601                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2602                                 set enable 1
2603                         }
2604                 } else {
2605                         catch {
2606                                 set fd [open [gitdir remotes $r] r]
2607                                 while {[gets $fd n] >= 0} {
2608                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2609                                                 set enable 1
2610                                                 break
2611                                         }
2612                                 }
2613                                 close $fd
2614                         }
2615                 }
2616
2617                 if {$enable} {
2618                         if {!$fast_count} {
2619                                 $m add separator
2620                         }
2621                         $m add command \
2622                                 -label "Push to $r..." \
2623                                 -command [list push_to $r] \
2624                                 -font font_ui
2625                         incr fast_count
2626                 }
2627         }
2628 }
2629
2630 proc start_push_anywhere_action {w} {
2631         global push_urltype push_remote push_url push_thin push_tags
2632
2633         set r_url {}
2634         switch -- $push_urltype {
2635         remote {set r_url $push_remote}
2636         url {set r_url $push_url}
2637         }
2638         if {$r_url eq {}} return
2639
2640         set cmd [list git push]
2641         lappend cmd -v
2642         if {$push_thin} {
2643                 lappend cmd --thin
2644         }
2645         if {$push_tags} {
2646                 lappend cmd --tags
2647         }
2648         lappend cmd $r_url
2649         set cnt 0
2650         foreach i [$w.source.l curselection] {
2651                 set b [$w.source.l get $i]
2652                 lappend cmd "refs/heads/$b:refs/heads/$b"
2653                 incr cnt
2654         }
2655         if {$cnt == 0} {
2656                 return
2657         } elseif {$cnt == 1} {
2658                 set unit branch
2659         } else {
2660                 set unit branches
2661         }
2662
2663         set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2664         console_exec $cons $cmd console_done
2665         destroy $w
2666 }
2667
2668 trace add variable push_remote write \
2669         [list radio_selector push_urltype remote]
2670
2671 proc do_push_anywhere {} {
2672         global all_heads all_remotes current_branch
2673         global push_urltype push_remote push_url push_thin push_tags
2674
2675         set w .push_setup
2676         toplevel $w
2677         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2678
2679         label $w.header -text {Push Branches} -font font_uibold
2680         pack $w.header -side top -fill x
2681
2682         frame $w.buttons
2683         button $w.buttons.create -text Push \
2684                 -font font_ui \
2685                 -command [list start_push_anywhere_action $w]
2686         pack $w.buttons.create -side right
2687         button $w.buttons.cancel -text {Cancel} \
2688                 -font font_ui \
2689                 -command [list destroy $w]
2690         pack $w.buttons.cancel -side right -padx 5
2691         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2692
2693         labelframe $w.source \
2694                 -text {Source Branches} \
2695                 -font font_ui
2696         listbox $w.source.l \
2697                 -height 10 \
2698                 -width 70 \
2699                 -selectmode extended \
2700                 -yscrollcommand [list $w.source.sby set] \
2701                 -font font_ui
2702         foreach h $all_heads {
2703                 $w.source.l insert end $h
2704                 if {$h eq $current_branch} {
2705                         $w.source.l select set end
2706                 }
2707         }
2708         scrollbar $w.source.sby -command [list $w.source.l yview]
2709         pack $w.source.sby -side right -fill y
2710         pack $w.source.l -side left -fill both -expand 1
2711         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2712
2713         labelframe $w.dest \
2714                 -text {Destination Repository} \
2715                 -font font_ui
2716         if {$all_remotes ne {}} {
2717                 radiobutton $w.dest.remote_r \
2718                         -text {Remote:} \
2719                         -value remote \
2720                         -variable push_urltype \
2721                         -font font_ui
2722                 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2723                 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2724                 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2725                         set push_remote origin
2726                 } else {
2727                         set push_remote [lindex $all_remotes 0]
2728                 }
2729                 set push_urltype remote
2730         } else {
2731                 set push_urltype url
2732         }
2733         radiobutton $w.dest.url_r \
2734                 -text {Arbitrary URL:} \
2735                 -value url \
2736                 -variable push_urltype \
2737                 -font font_ui
2738         entry $w.dest.url_t \
2739                 -borderwidth 1 \
2740                 -relief sunken \
2741                 -width 50 \
2742                 -textvariable push_url \
2743                 -font font_ui \
2744                 -validate key \
2745                 -validatecommand {
2746                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2747                         if {%d == 1 && [string length %S] > 0} {
2748                                 set push_urltype url
2749                         }
2750                         return 1
2751                 }
2752         grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2753         grid columnconfigure $w.dest 1 -weight 1
2754         pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2755
2756         labelframe $w.options \
2757                 -text {Transfer Options} \
2758                 -font font_ui
2759         checkbutton $w.options.thin \
2760                 -text {Use thin pack (for slow network connections)} \
2761                 -variable push_thin \
2762                 -font font_ui
2763         grid $w.options.thin -columnspan 2 -sticky w
2764         checkbutton $w.options.tags \
2765                 -text {Include tags} \
2766                 -variable push_tags \
2767                 -font font_ui
2768         grid $w.options.tags -columnspan 2 -sticky w
2769         grid columnconfigure $w.options 1 -weight 1
2770         pack $w.options -anchor nw -fill x -pady 5 -padx 5
2771
2772         set push_url {}
2773         set push_thin 0
2774         set push_tags 0
2775
2776         bind $w <Visibility> "grab $w"
2777         bind $w <Key-Escape> "destroy $w"
2778         wm title $w "[appname] ([reponame]): Push"
2779         tkwait window $w
2780 }
2781
2782 ######################################################################
2783 ##
2784 ## merge
2785
2786 proc can_merge {} {
2787         global HEAD commit_type file_states
2788
2789         if {[string match amend* $commit_type]} {
2790                 info_popup {Cannot merge while amending.
2791
2792 You must finish amending this commit before
2793 starting any type of merge.
2794 }
2795                 return 0
2796         }
2797
2798         if {[committer_ident] eq {}} {return 0}
2799         if {![lock_index merge]} {return 0}
2800
2801         # -- Our in memory state should match the repository.
2802         #
2803         repository_state curType curHEAD curMERGE_HEAD
2804         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2805                 info_popup {Last scanned state does not match repository state.
2806
2807 Another Git program has modified this repository
2808 since the last scan.  A rescan must be performed
2809 before a merge can be performed.
2810
2811 The rescan will be automatically started now.
2812 }
2813                 unlock_index
2814                 rescan {set ui_status_value {Ready.}}
2815                 return 0
2816         }
2817
2818         foreach path [array names file_states] {
2819                 switch -glob -- [lindex $file_states($path) 0] {
2820                 _O {
2821                         continue; # and pray it works!
2822                 }
2823                 U? {
2824                         error_popup "You are in the middle of a conflicted merge.
2825
2826 File [short_path $path] has merge conflicts.
2827
2828 You must resolve them, add the file, and commit to
2829 complete the current merge.  Only then can you
2830 begin another merge.
2831 "
2832                         unlock_index
2833                         return 0
2834                 }
2835                 ?? {
2836                         error_popup "You are in the middle of a change.
2837
2838 File [short_path $path] is modified.
2839
2840 You should complete the current commit before
2841 starting a merge.  Doing so will help you abort
2842 a failed merge, should the need arise.
2843 "
2844                         unlock_index
2845                         return 0
2846                 }
2847                 }
2848         }
2849
2850         return 1
2851 }
2852
2853 proc visualize_local_merge {w} {
2854         set revs {}
2855         foreach i [$w.source.l curselection] {
2856                 lappend revs [$w.source.l get $i]
2857         }
2858         if {$revs eq {}} return
2859         lappend revs --not HEAD
2860         do_gitk $revs
2861 }
2862
2863 proc start_local_merge_action {w} {
2864         global HEAD ui_status_value current_branch
2865
2866         set cmd [list git merge]
2867         set names {}
2868         set revcnt 0
2869         foreach i [$w.source.l curselection] {
2870                 set b [$w.source.l get $i]
2871                 lappend cmd $b
2872                 lappend names $b
2873                 incr revcnt
2874         }
2875
2876         if {$revcnt == 0} {
2877                 return
2878         } elseif {$revcnt == 1} {
2879                 set unit branch
2880         } elseif {$revcnt <= 15} {
2881                 set unit branches
2882         } else {
2883                 tk_messageBox \
2884                         -icon error \
2885                         -type ok \
2886                         -title [wm title $w] \
2887                         -parent $w \
2888                         -message "Too many branches selected.
2889
2890 You have requested to merge $revcnt branches
2891 in an octopus merge.  This exceeds Git's
2892 internal limit of 15 branches per merge.
2893
2894 Please select fewer branches.  To merge more
2895 than 15 branches, merge the branches in batches.
2896 "
2897                 return
2898         }
2899
2900         set msg "Merging $current_branch, [join $names {, }]"
2901         set ui_status_value "$msg..."
2902         set cons [new_console "Merge" $msg]
2903         console_exec $cons $cmd [list finish_merge $revcnt]
2904         bind $w <Destroy> {}
2905         destroy $w
2906 }
2907
2908 proc finish_merge {revcnt w ok} {
2909         console_done $w $ok
2910         if {$ok} {
2911                 set msg {Merge completed successfully.}
2912         } else {
2913                 if {$revcnt != 1} {
2914                         info_popup "Octopus merge failed.
2915
2916 Your merge of $revcnt branches has failed.
2917
2918 There are file-level conflicts between the
2919 branches which must be resolved manually.
2920
2921 The working directory will now be reset.
2922
2923 You can attempt this merge again
2924 by merging only one branch at a time." $w
2925
2926                         set fd [open "| git read-tree --reset -u HEAD" r]
2927                         fconfigure $fd -blocking 0 -translation binary
2928                         fileevent $fd readable [list reset_hard_wait $fd]
2929                         set ui_status_value {Aborting... please wait...}
2930                         return
2931                 }
2932
2933                 set msg {Merge failed.  Conflict resolution is required.}
2934         }
2935         unlock_index
2936         rescan [list set ui_status_value $msg]
2937 }
2938
2939 proc do_local_merge {} {
2940         global current_branch
2941
2942         if {![can_merge]} return
2943
2944         set w .merge_setup
2945         toplevel $w
2946         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2947
2948         label $w.header \
2949                 -text "Merge Into $current_branch" \
2950                 -font font_uibold
2951         pack $w.header -side top -fill x
2952
2953         frame $w.buttons
2954         button $w.buttons.visualize -text Visualize \
2955                 -font font_ui \
2956                 -command [list visualize_local_merge $w]
2957         pack $w.buttons.visualize -side left
2958         button $w.buttons.create -text Merge \
2959                 -font font_ui \
2960                 -command [list start_local_merge_action $w]
2961         pack $w.buttons.create -side right
2962         button $w.buttons.cancel -text {Cancel} \
2963                 -font font_ui \
2964                 -command [list destroy $w]
2965         pack $w.buttons.cancel -side right -padx 5
2966         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2967
2968         labelframe $w.source \
2969                 -text {Source Branches} \
2970                 -font font_ui
2971         listbox $w.source.l \
2972                 -height 10 \
2973                 -width 70 \
2974                 -selectmode extended \
2975                 -yscrollcommand [list $w.source.sby set] \
2976                 -font font_ui
2977         scrollbar $w.source.sby -command [list $w.source.l yview]
2978         pack $w.source.sby -side right -fill y
2979         pack $w.source.l -side left -fill both -expand 1
2980         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2981
2982         set cmd [list git for-each-ref]
2983         lappend cmd {--format=%(objectname) %(*objectname) %(refname)}
2984         lappend cmd refs/heads
2985         lappend cmd refs/remotes
2986         lappend cmd refs/tags
2987         set fr_fd [open "| $cmd" r]
2988         fconfigure $fr_fd -translation binary
2989         while {[gets $fr_fd line] > 0} {
2990                 set line [split $line { }]
2991                 set sha1([lindex $line 0]) [lindex $line 2]
2992                 set sha1([lindex $line 1]) [lindex $line 2]
2993         }
2994         close $fr_fd
2995
2996         set to_show {}
2997         set fr_fd [open "| git rev-list --all --not HEAD"]
2998         while {[gets $fr_fd line] > 0} {
2999                 if {[catch {set ref $sha1($line)}]} continue
3000                 regsub ^refs/(heads|remotes|tags)/ $ref {} ref
3001                 lappend to_show $ref
3002         }
3003         close $fr_fd
3004
3005         foreach ref [lsort -unique $to_show] {
3006                 $w.source.l insert end $ref
3007         }
3008
3009         bind $w <Visibility> "grab $w"
3010         bind $w <Key-Escape> "unlock_index;destroy $w"
3011         bind $w <Destroy> unlock_index
3012         wm title $w "[appname] ([reponame]): Merge"
3013         tkwait window $w
3014 }
3015
3016 proc do_reset_hard {} {
3017         global HEAD commit_type file_states
3018
3019         if {[string match amend* $commit_type]} {
3020                 info_popup {Cannot abort while amending.
3021
3022 You must finish amending this commit.
3023 }
3024                 return
3025         }
3026
3027         if {![lock_index abort]} return
3028
3029         if {[string match *merge* $commit_type]} {
3030                 set op merge
3031         } else {
3032                 set op commit
3033         }
3034
3035         if {[ask_popup "Abort $op?
3036
3037 Aborting the current $op will cause
3038 *ALL* uncommitted changes to be lost.
3039
3040 Continue with aborting the current $op?"] eq {yes}} {
3041                 set fd [open "| git read-tree --reset -u HEAD" r]
3042                 fconfigure $fd -blocking 0 -translation binary
3043                 fileevent $fd readable [list reset_hard_wait $fd]
3044                 set ui_status_value {Aborting... please wait...}
3045         } else {
3046                 unlock_index
3047         }
3048 }
3049
3050 proc reset_hard_wait {fd} {
3051         global ui_comm
3052
3053         read $fd
3054         if {[eof $fd]} {
3055                 close $fd
3056                 unlock_index
3057
3058                 $ui_comm delete 0.0 end
3059                 $ui_comm edit modified false
3060
3061                 catch {file delete [gitdir MERGE_HEAD]}
3062                 catch {file delete [gitdir rr-cache MERGE_RR]}
3063                 catch {file delete [gitdir SQUASH_MSG]}
3064                 catch {file delete [gitdir MERGE_MSG]}
3065                 catch {file delete [gitdir GITGUI_MSG]}
3066
3067                 rescan {set ui_status_value {Abort completed.  Ready.}}
3068         }
3069 }
3070
3071 ######################################################################
3072 ##
3073 ## browser
3074
3075 set next_browser_id 0
3076
3077 proc new_browser {commit} {
3078         global next_browser_id cursor_ptr M1B
3079         global browser_commit browser_status browser_stack browser_path browser_busy
3080
3081         if {[winfo ismapped .]} {
3082                 set w .browser[incr next_browser_id]
3083                 set tl $w
3084                 toplevel $w
3085         } else {
3086                 set w {}
3087                 set tl .
3088         }
3089         set w_list $w.list.l
3090         set browser_commit($w_list) $commit
3091         set browser_status($w_list) {Starting...}
3092         set browser_stack($w_list) {}
3093         set browser_path($w_list) $browser_commit($w_list):
3094         set browser_busy($w_list) 1
3095
3096         label $w.path -textvariable browser_path($w_list) \
3097                 -anchor w \
3098                 -justify left \
3099                 -borderwidth 1 \
3100                 -relief sunken \
3101                 -font font_uibold
3102         pack $w.path -anchor w -side top -fill x
3103
3104         frame $w.list
3105         text $w_list -background white -borderwidth 0 \
3106                 -cursor $cursor_ptr \
3107                 -state disabled \
3108                 -wrap none \
3109                 -height 20 \
3110                 -width 70 \
3111                 -xscrollcommand [list $w.list.sbx set] \
3112                 -yscrollcommand [list $w.list.sby set] \
3113                 -font font_ui
3114         $w_list tag conf in_sel \
3115                 -background [$w_list cget -foreground] \
3116                 -foreground [$w_list cget -background]
3117         scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3118         scrollbar $w.list.sby -orient v -command [list $w_list yview]
3119         pack $w.list.sbx -side bottom -fill x
3120         pack $w.list.sby -side right -fill y
3121         pack $w_list -side left -fill both -expand 1
3122         pack $w.list -side top -fill both -expand 1
3123
3124         label $w.status -textvariable browser_status($w_list) \
3125                 -anchor w \
3126                 -justify left \
3127                 -borderwidth 1 \
3128                 -relief sunken \
3129                 -font font_ui
3130         pack $w.status -anchor w -side bottom -fill x
3131
3132         bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3133         bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3134         bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3135         bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3136         bind $w_list <Up>              "browser_move -1 $w_list;break"
3137         bind $w_list <Down>            "browser_move 1 $w_list;break"
3138         bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3139         bind $w_list <Return>          "browser_enter $w_list;break"
3140         bind $w_list <Prior>           "browser_page -1 $w_list;break"
3141         bind $w_list <Next>            "browser_page 1 $w_list;break"
3142         bind $w_list <Left>            break
3143         bind $w_list <Right>           break
3144
3145         bind $tl <Visibility> "focus $w"
3146         bind $tl <Destroy> "
3147                 array unset browser_buffer $w_list
3148                 array unset browser_files $w_list
3149                 array unset browser_status $w_list
3150                 array unset browser_stack $w_list
3151                 array unset browser_path $w_list
3152                 array unset browser_commit $w_list
3153                 array unset browser_busy $w_list
3154         "
3155         wm title $tl "[appname] ([reponame]): File Browser"
3156         ls_tree $w_list $browser_commit($w_list) {}
3157 }
3158
3159 proc browser_move {dir w} {
3160         global browser_files browser_busy
3161
3162         if {$browser_busy($w)} return
3163         set lno [lindex [split [$w index in_sel.first] .] 0]
3164         incr lno $dir
3165         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3166                 $w tag remove in_sel 0.0 end
3167                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3168                 $w see $lno.0
3169         }
3170 }
3171
3172 proc browser_page {dir w} {
3173         global browser_files browser_busy
3174
3175         if {$browser_busy($w)} return
3176         $w yview scroll $dir pages
3177         set lno [expr {int(
3178                   [lindex [$w yview] 0]
3179                 * [llength $browser_files($w)]
3180                 + 1)}]
3181         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3182                 $w tag remove in_sel 0.0 end
3183                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3184                 $w see $lno.0
3185         }
3186 }
3187
3188 proc browser_parent {w} {
3189         global browser_files browser_status browser_path
3190         global browser_stack browser_busy
3191
3192         if {$browser_busy($w)} return
3193         set info [lindex $browser_files($w) 0]
3194         if {[lindex $info 0] eq {parent}} {
3195                 set parent [lindex $browser_stack($w) end-1]
3196                 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3197                 if {$browser_stack($w) eq {}} {
3198                         regsub {:.*$} $browser_path($w) {:} browser_path($w)
3199                 } else {
3200                         regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3201                 }
3202                 set browser_status($w) "Loading $browser_path($w)..."
3203                 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3204         }
3205 }
3206
3207 proc browser_enter {w} {
3208         global browser_files browser_status browser_path
3209         global browser_commit browser_stack browser_busy
3210
3211         if {$browser_busy($w)} return
3212         set lno [lindex [split [$w index in_sel.first] .] 0]
3213         set info [lindex $browser_files($w) [expr {$lno - 1}]]
3214         if {$info ne {}} {
3215                 switch -- [lindex $info 0] {
3216                 parent {
3217                         browser_parent $w
3218                 }
3219                 tree {
3220                         set name [lindex $info 2]
3221                         set escn [escape_path $name]
3222                         set browser_status($w) "Loading $escn..."
3223                         append browser_path($w) $escn
3224                         ls_tree $w [lindex $info 1] $name
3225                 }
3226                 blob {
3227                         set name [lindex $info 2]
3228                         set p {}
3229                         foreach n $browser_stack($w) {
3230                                 append p [lindex $n 1]
3231                         }
3232                         append p $name
3233                         show_blame $browser_commit($w) $p
3234                 }
3235                 }
3236         }
3237 }
3238
3239 proc browser_click {was_double_click w pos} {
3240         global browser_files browser_busy
3241
3242         if {$browser_busy($w)} return
3243         set lno [lindex [split [$w index $pos] .] 0]
3244         focus $w
3245
3246         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3247                 $w tag remove in_sel 0.0 end
3248                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3249                 if {$was_double_click} {
3250                         browser_enter $w
3251                 }
3252         }
3253 }
3254
3255 proc ls_tree {w tree_id name} {
3256         global browser_buffer browser_files browser_stack browser_busy
3257
3258         set browser_buffer($w) {}
3259         set browser_files($w) {}
3260         set browser_busy($w) 1
3261
3262         $w conf -state normal
3263         $w tag remove in_sel 0.0 end
3264         $w delete 0.0 end
3265         if {$browser_stack($w) ne {}} {
3266                 $w image create end \
3267                         -align center -padx 5 -pady 1 \
3268                         -name icon0 \
3269                         -image file_uplevel
3270                 $w insert end {[Up To Parent]}
3271                 lappend browser_files($w) parent
3272         }
3273         lappend browser_stack($w) [list $tree_id $name]
3274         $w conf -state disabled
3275
3276         set cmd [list git ls-tree -z $tree_id]
3277         set fd [open "| $cmd" r]
3278         fconfigure $fd -blocking 0 -translation binary -encoding binary
3279         fileevent $fd readable [list read_ls_tree $fd $w]
3280 }
3281
3282 proc read_ls_tree {fd w} {
3283         global browser_buffer browser_files browser_status browser_busy
3284
3285         if {![winfo exists $w]} {
3286                 catch {close $fd}
3287                 return
3288         }
3289
3290         append browser_buffer($w) [read $fd]
3291         set pck [split $browser_buffer($w) "\0"]
3292         set browser_buffer($w) [lindex $pck end]
3293
3294         set n [llength $browser_files($w)]
3295         $w conf -state normal
3296         foreach p [lrange $pck 0 end-1] {
3297                 set info [split $p "\t"]
3298                 set path [lindex $info 1]
3299                 set info [split [lindex $info 0] { }]
3300                 set type [lindex $info 1]
3301                 set object [lindex $info 2]
3302
3303                 switch -- $type {
3304                 blob {
3305                         set image file_mod
3306                 }
3307                 tree {
3308                         set image file_dir
3309                         append path /
3310                 }
3311                 default {
3312                         set image file_question
3313                 }
3314                 }
3315
3316                 if {$n > 0} {$w insert end "\n"}
3317                 $w image create end \
3318                         -align center -padx 5 -pady 1 \
3319                         -name icon[incr n] \
3320                         -image $image
3321                 $w insert end [escape_path $path]
3322                 lappend browser_files($w) [list $type $object $path]
3323         }
3324         $w conf -state disabled
3325
3326         if {[eof $fd]} {
3327                 close $fd
3328                 set browser_status($w) Ready.
3329                 set browser_busy($w) 0
3330                 array unset browser_buffer $w
3331                 if {$n > 0} {
3332                         $w tag add in_sel 1.0 2.0
3333                         focus -force $w
3334                 }
3335         }
3336 }
3337
3338 proc show_blame {commit path} {
3339         global next_browser_id blame_status blame_data
3340
3341         if {[winfo ismapped .]} {
3342                 set w .browser[incr next_browser_id]
3343                 set tl $w
3344                 toplevel $w
3345         } else {
3346                 set w {}
3347                 set tl .
3348         }
3349         set blame_status($w) {Loading current file content...}
3350
3351         label $w.path -text "$commit:$path" \
3352                 -anchor w \
3353                 -justify left \
3354                 -borderwidth 1 \
3355                 -relief sunken \
3356                 -font font_uibold
3357         pack $w.path -side top -fill x
3358
3359         frame $w.out
3360         text $w.out.loaded_t \
3361                 -background white -borderwidth 0 \
3362                 -state disabled \
3363                 -wrap none \
3364                 -height 40 \
3365                 -width 1 \
3366                 -font font_diff
3367         $w.out.loaded_t tag conf annotated -background grey
3368
3369         text $w.out.linenumber_t \
3370                 -background white -borderwidth 0 \
3371                 -state disabled \
3372                 -wrap none \
3373                 -height 40 \
3374                 -width 5 \
3375                 -font font_diff
3376         $w.out.linenumber_t tag conf linenumber -justify right
3377
3378         text $w.out.file_t \
3379                 -background white -borderwidth 0 \
3380                 -state disabled \
3381                 -wrap none \
3382                 -height 40 \
3383                 -width 80 \
3384                 -xscrollcommand [list $w.out.sbx set] \
3385                 -font font_diff
3386
3387         scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3388         scrollbar $w.out.sby -orient v \
3389                 -command [list scrollbar2many [list \
3390                 $w.out.loaded_t \
3391                 $w.out.linenumber_t \
3392                 $w.out.file_t \
3393                 ] yview]
3394         grid \
3395                 $w.out.linenumber_t \
3396                 $w.out.loaded_t \
3397                 $w.out.file_t \
3398                 $w.out.sby \
3399                 -sticky nsew
3400         grid conf $w.out.sbx -column 2 -sticky we
3401         grid columnconfigure $w.out 2 -weight 1
3402         grid rowconfigure $w.out 0 -weight 1
3403         pack $w.out -fill both -expand 1
3404
3405         label $w.status -textvariable blame_status($w) \
3406                 -anchor w \
3407                 -justify left \
3408                 -borderwidth 1 \
3409                 -relief sunken \
3410                 -font font_ui
3411         pack $w.status -side bottom -fill x
3412
3413         frame $w.cm
3414         text $w.cm.t \
3415                 -background white -borderwidth 0 \
3416                 -state disabled \
3417                 -wrap none \
3418                 -height 10 \
3419                 -width 80 \
3420                 -xscrollcommand [list $w.cm.sbx set] \
3421                 -yscrollcommand [list $w.cm.sby set] \
3422                 -font font_diff
3423         scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3424         scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3425         pack $w.cm.sby -side right -fill y
3426         pack $w.cm.sbx -side bottom -fill x
3427         pack $w.cm.t -expand 1 -fill both
3428         pack $w.cm -side bottom -fill x
3429
3430         menu $w.ctxm -tearoff 0
3431         $w.ctxm add command -label "Copy Commit" \
3432                 -font font_ui \
3433                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3434
3435         foreach i [list \
3436                 $w.out.loaded_t \
3437                 $w.out.linenumber_t \
3438                 $w.out.file_t] {
3439                 $i tag conf in_sel \
3440                         -background [$i cget -foreground] \
3441                         -foreground [$i cget -background]
3442                 $i conf -yscrollcommand \
3443                         [list many2scrollbar [list \
3444                         $w.out.loaded_t \
3445                         $w.out.linenumber_t \
3446                         $w.out.file_t \
3447                         ] yview $w.out.sby]
3448                 bind $i <Button-1> "
3449                         blame_click {$w} \\
3450                                 $w.cm.t \\
3451                                 $w.out.linenumber_t \\
3452                                 $w.out.file_t \\
3453                                 $i @%x,%y
3454                         focus $i
3455                 "
3456                 bind_button3 $i "
3457                         set cursorX %x
3458                         set cursorY %y
3459                         set cursorW %W
3460                         tk_popup $w.ctxm %X %Y
3461                 "
3462         }
3463
3464         bind $w.cm.t <Button-1> "focus $w.cm.t"
3465         bind $tl <Visibility> "focus $tl"
3466         bind $tl <Destroy> "
3467                 array unset blame_status {$w}
3468                 array unset blame_data $w,*
3469         "
3470         wm title $tl "[appname] ([reponame]): File Viewer"
3471
3472         set blame_data($w,commit_count) 0
3473         set blame_data($w,commit_list) {}
3474         set blame_data($w,total_lines) 0
3475         set blame_data($w,blame_lines) 0
3476         set blame_data($w,highlight_commit) {}
3477         set blame_data($w,highlight_line) -1
3478
3479         set cmd [list git cat-file blob "$commit:$path"]
3480         set fd [open "| $cmd" r]
3481         fconfigure $fd -blocking 0 -translation lf -encoding binary
3482         fileevent $fd readable [list read_blame_catfile \
3483                 $fd $w $commit $path \
3484                 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3485 }
3486
3487 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3488         global blame_status blame_data
3489
3490         if {![winfo exists $w_file]} {
3491                 catch {close $fd}
3492                 return
3493         }
3494
3495         set n $blame_data($w,total_lines)
3496         $w_load conf -state normal
3497         $w_line conf -state normal
3498         $w_file conf -state normal
3499         while {[gets $fd line] >= 0} {
3500                 regsub "\r\$" $line {} line
3501                 incr n
3502                 $w_load insert end "\n"
3503                 $w_line insert end "$n\n" linenumber
3504                 $w_file insert end "$line\n"
3505         }
3506         $w_load conf -state disabled
3507         $w_line conf -state disabled
3508         $w_file conf -state disabled
3509         set blame_data($w,total_lines) $n
3510
3511         if {[eof $fd]} {
3512                 close $fd
3513                 blame_incremental_status $w
3514                 set cmd [list git blame -M -C --incremental]
3515                 lappend cmd $commit -- $path
3516                 set fd [open "| $cmd" r]
3517                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3518                 fileevent $fd readable [list read_blame_incremental $fd $w \
3519                         $w_load $w_cmit $w_line $w_file]
3520         }
3521 }
3522
3523 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3524         global blame_status blame_data
3525
3526         if {![winfo exists $w_file]} {
3527                 catch {close $fd}
3528                 return
3529         }
3530
3531         while {[gets $fd line] >= 0} {
3532                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3533                         cmit original_line final_line line_count]} {
3534                         set blame_data($w,commit) $cmit
3535                         set blame_data($w,original_line) $original_line
3536                         set blame_data($w,final_line) $final_line
3537                         set blame_data($w,line_count) $line_count
3538
3539                         if {[catch {set g $blame_data($w,$cmit,order)}]} {
3540                                 $w_line tag conf g$cmit
3541                                 $w_file tag conf g$cmit
3542                                 $w_line tag raise in_sel
3543                                 $w_file tag raise in_sel
3544                                 $w_file tag raise sel
3545                                 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3546                                 incr blame_data($w,commit_count)
3547                                 lappend blame_data($w,commit_list) $cmit
3548                         }
3549                 } elseif {[string match {filename *} $line]} {
3550                         set file [string range $line 9 end]
3551                         set n $blame_data($w,line_count)
3552                         set lno $blame_data($w,final_line)
3553                         set cmit $blame_data($w,commit)
3554
3555                         while {$n > 0} {
3556                                 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3557                                         $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3558                                 } else {
3559                                         $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3560                                         $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3561                                 }
3562
3563                                 set blame_data($w,line$lno,commit) $cmit
3564                                 set blame_data($w,line$lno,file) $file
3565                                 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3566                                 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3567
3568                                 if {$blame_data($w,highlight_line) == -1} {
3569                                         if {[lindex [$w_file yview] 0] == 0} {
3570                                                 $w_file see $lno.0
3571                                                 blame_showcommit $w $w_cmit $w_line $w_file $lno
3572                                         }
3573                                 } elseif {$blame_data($w,highlight_line) == $lno} {
3574                                         blame_showcommit $w $w_cmit $w_line $w_file $lno
3575                                 }
3576
3577                                 incr n -1
3578                                 incr lno
3579                                 incr blame_data($w,blame_lines)
3580                         }
3581
3582                         set hc $blame_data($w,highlight_commit)
3583                         if {$hc ne {}
3584                                 && [expr {$blame_data($w,$hc,order) + 1}]
3585                                         == $blame_data($w,$cmit,order)} {
3586                                 blame_showcommit $w $w_cmit $w_line $w_file \
3587                                         $blame_data($w,highlight_line)
3588                         }
3589                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3590                         set blame_data($w,$blame_data($w,commit),$header) $data
3591                 }
3592         }
3593
3594         if {[eof $fd]} {
3595                 close $fd
3596                 set blame_status($w) {Annotation complete.}
3597         } else {
3598                 blame_incremental_status $w
3599         }
3600 }
3601
3602 proc blame_incremental_status {w} {
3603         global blame_status blame_data
3604
3605         set blame_status($w) [format \
3606                 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3607                 $blame_data($w,blame_lines) \
3608                 $blame_data($w,total_lines) \
3609                 [expr {100 * $blame_data($w,blame_lines)
3610                         / $blame_data($w,total_lines)}]]
3611 }
3612
3613 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3614         set lno [lindex [split [$cur_w index $pos] .] 0]
3615         if {$lno eq {}} return
3616
3617         $w_line tag remove in_sel 0.0 end
3618         $w_file tag remove in_sel 0.0 end
3619         $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3620         $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3621
3622         blame_showcommit $w $w_cmit $w_line $w_file $lno
3623 }
3624
3625 set blame_colors {
3626         #ff4040
3627         #ff40ff
3628         #4040ff
3629 }
3630
3631 proc blame_showcommit {w w_cmit w_line w_file lno} {
3632         global blame_colors blame_data repo_config
3633
3634         set cmit $blame_data($w,highlight_commit)
3635         if {$cmit ne {}} {
3636                 set idx $blame_data($w,$cmit,order)
3637                 set i 0
3638                 foreach c $blame_colors {
3639                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3640                         $w_line tag conf g$h -background white
3641                         $w_file tag conf g$h -background white
3642                         incr i
3643                 }
3644         }
3645
3646         $w_cmit conf -state normal
3647         $w_cmit delete 0.0 end
3648         if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3649                 set cmit {}
3650                 $w_cmit insert end "Loading annotation..."
3651         } else {
3652                 set idx $blame_data($w,$cmit,order)
3653                 set i 0
3654                 foreach c $blame_colors {
3655                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3656                         $w_line tag conf g$h -background $c
3657                         $w_file tag conf g$h -background $c
3658                         incr i
3659                 }
3660
3661                 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3662                         set msg {}
3663                         catch {
3664                                 set fd [open "| git cat-file commit $cmit" r]
3665                                 fconfigure $fd -encoding binary -translation lf
3666                                 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3667                                         set enc utf-8
3668                                 }
3669                                 while {[gets $fd line] > 0} {
3670                                         if {[string match {encoding *} $line]} {
3671                                                 set enc [string tolower [string range $line 9 end]]
3672                                         }
3673                                 }
3674                                 fconfigure $fd -encoding $enc
3675                                 set msg [string trim [read $fd]]
3676                                 close $fd
3677                         }
3678                         set blame_data($w,$cmit,message) $msg
3679                 }
3680
3681                 set author_name {}
3682                 set author_email {}
3683                 set author_time {}
3684                 catch {set author_name $blame_data($w,$cmit,author)}
3685                 catch {set author_email $blame_data($w,$cmit,author-mail)}
3686                 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3687
3688                 set committer_name {}
3689                 set committer_email {}
3690                 set committer_time {}
3691                 catch {set committer_name $blame_data($w,$cmit,committer)}
3692                 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3693                 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3694
3695                 $w_cmit insert end "commit $cmit\n"
3696                 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3697                 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3698                 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3699                 $w_cmit insert end "\n"
3700                 $w_cmit insert end $msg
3701         }
3702         $w_cmit conf -state disabled
3703
3704         set blame_data($w,highlight_line) $lno
3705         set blame_data($w,highlight_commit) $cmit
3706 }
3707
3708 proc blame_copycommit {w i pos} {
3709         global blame_data
3710         set lno [lindex [split [$i index $pos] .] 0]
3711         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3712                 clipboard clear
3713                 clipboard append \
3714                         -format STRING \
3715                         -type STRING \
3716                         -- $commit
3717         }
3718 }
3719
3720 ######################################################################
3721 ##
3722 ## icons
3723
3724 set filemask {
3725 #define mask_width 14
3726 #define mask_height 15
3727 static unsigned char mask_bits[] = {
3728    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3729    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3730    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3731 }
3732
3733 image create bitmap file_plain -background white -foreground black -data {
3734 #define plain_width 14
3735 #define plain_height 15
3736 static unsigned char plain_bits[] = {
3737    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3738    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3739    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3740 } -maskdata $filemask
3741
3742 image create bitmap file_mod -background white -foreground blue -data {
3743 #define mod_width 14
3744 #define mod_height 15
3745 static unsigned char mod_bits[] = {
3746    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3747    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3748    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3749 } -maskdata $filemask
3750
3751 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3752 #define file_fulltick_width 14
3753 #define file_fulltick_height 15
3754 static unsigned char file_fulltick_bits[] = {
3755    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3756    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3757    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3758 } -maskdata $filemask
3759
3760 image create bitmap file_parttick -background white -foreground "#005050" -data {
3761 #define parttick_width 14
3762 #define parttick_height 15
3763 static unsigned char parttick_bits[] = {
3764    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3765    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3766    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3767 } -maskdata $filemask
3768
3769 image create bitmap file_question -background white -foreground black -data {
3770 #define file_question_width 14
3771 #define file_question_height 15
3772 static unsigned char file_question_bits[] = {
3773    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3774    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3775    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3776 } -maskdata $filemask
3777
3778 image create bitmap file_removed -background white -foreground red -data {
3779 #define file_removed_width 14
3780 #define file_removed_height 15
3781 static unsigned char file_removed_bits[] = {
3782    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3783    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3784    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3785 } -maskdata $filemask
3786
3787 image create bitmap file_merge -background white -foreground blue -data {
3788 #define file_merge_width 14
3789 #define file_merge_height 15
3790 static unsigned char file_merge_bits[] = {
3791    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3792    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3793    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3794 } -maskdata $filemask
3795
3796 set file_dir_data {
3797 #define file_width 18
3798 #define file_height 18
3799 static unsigned char file_bits[] = {
3800   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3801   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3802   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3803   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3804   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3805 }
3806 image create bitmap file_dir -background white -foreground blue \
3807         -data $file_dir_data -maskdata $file_dir_data
3808 unset file_dir_data
3809
3810 set file_uplevel_data {
3811 #define up_width 15
3812 #define up_height 15
3813 static unsigned char up_bits[] = {
3814   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3815   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3816   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3817 }
3818 image create bitmap file_uplevel -background white -foreground red \
3819         -data $file_uplevel_data -maskdata $file_uplevel_data
3820 unset file_uplevel_data
3821
3822 set ui_index .vpane.files.index.list
3823 set ui_workdir .vpane.files.workdir.list
3824
3825 set all_icons(_$ui_index)   file_plain
3826 set all_icons(A$ui_index)   file_fulltick
3827 set all_icons(M$ui_index)   file_fulltick
3828 set all_icons(D$ui_index)   file_removed
3829 set all_icons(U$ui_index)   file_merge
3830
3831 set all_icons(_$ui_workdir) file_plain
3832 set all_icons(M$ui_workdir) file_mod
3833 set all_icons(D$ui_workdir) file_question
3834 set all_icons(U$ui_workdir) file_merge
3835 set all_icons(O$ui_workdir) file_plain
3836
3837 set max_status_desc 0
3838 foreach i {
3839                 {__ "Unmodified"}
3840
3841                 {_M "Modified, not staged"}
3842                 {M_ "Staged for commit"}
3843                 {MM "Portions staged for commit"}
3844                 {MD "Staged for commit, missing"}
3845
3846                 {_O "Untracked, not staged"}
3847                 {A_ "Staged for commit"}
3848                 {AM "Portions staged for commit"}
3849                 {AD "Staged for commit, missing"}
3850
3851                 {_D "Missing"}
3852                 {D_ "Staged for removal"}
3853                 {DO "Staged for removal, still present"}
3854
3855                 {U_ "Requires merge resolution"}
3856                 {UU "Requires merge resolution"}
3857                 {UM "Requires merge resolution"}
3858                 {UD "Requires merge resolution"}
3859         } {
3860         if {$max_status_desc < [string length [lindex $i 1]]} {
3861                 set max_status_desc [string length [lindex $i 1]]
3862         }
3863         set all_descs([lindex $i 0]) [lindex $i 1]
3864 }
3865 unset i
3866
3867 ######################################################################
3868 ##
3869 ## util
3870
3871 proc bind_button3 {w cmd} {
3872         bind $w <Any-Button-3> $cmd
3873         if {[is_MacOSX]} {
3874                 bind $w <Control-Button-1> $cmd
3875         }
3876 }
3877
3878 proc scrollbar2many {list mode args} {
3879         foreach w $list {eval $w $mode $args}
3880 }
3881
3882 proc many2scrollbar {list mode sb top bottom} {
3883         $sb set $top $bottom
3884         foreach w $list {$w $mode moveto $top}
3885 }
3886
3887 proc incr_font_size {font {amt 1}} {
3888         set sz [font configure $font -size]
3889         incr sz $amt
3890         font configure $font -size $sz
3891         font configure ${font}bold -size $sz
3892 }
3893
3894 proc hook_failed_popup {hook msg} {
3895         set w .hookfail
3896         toplevel $w
3897
3898         frame $w.m
3899         label $w.m.l1 -text "$hook hook failed:" \
3900                 -anchor w \
3901                 -justify left \
3902                 -font font_uibold
3903         text $w.m.t \
3904                 -background white -borderwidth 1 \
3905                 -relief sunken \
3906                 -width 80 -height 10 \
3907                 -font font_diff \
3908                 -yscrollcommand [list $w.m.sby set]
3909         label $w.m.l2 \
3910                 -text {You must correct the above errors before committing.} \
3911                 -anchor w \
3912                 -justify left \
3913                 -font font_uibold
3914         scrollbar $w.m.sby -command [list $w.m.t yview]
3915         pack $w.m.l1 -side top -fill x
3916         pack $w.m.l2 -side bottom -fill x
3917         pack $w.m.sby -side right -fill y
3918         pack $w.m.t -side left -fill both -expand 1
3919         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3920
3921         $w.m.t insert 1.0 $msg
3922         $w.m.t conf -state disabled
3923
3924         button $w.ok -text OK \
3925                 -width 15 \
3926                 -font font_ui \
3927                 -command "destroy $w"
3928         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3929
3930         bind $w <Visibility> "grab $w; focus $w"
3931         bind $w <Key-Return> "destroy $w"
3932         wm title $w "[appname] ([reponame]): error"
3933         tkwait window $w
3934 }
3935
3936 set next_console_id 0
3937
3938 proc new_console {short_title long_title} {
3939         global next_console_id console_data
3940         set w .console[incr next_console_id]
3941         set console_data($w) [list $short_title $long_title]
3942         return [console_init $w]
3943 }
3944
3945 proc console_init {w} {
3946         global console_cr console_data M1B
3947
3948         set console_cr($w) 1.0
3949         toplevel $w
3950         frame $w.m
3951         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3952                 -anchor w \
3953                 -justify left \
3954                 -font font_uibold
3955         text $w.m.t \
3956                 -background white -borderwidth 1 \
3957                 -relief sunken \
3958                 -width 80 -height 10 \
3959                 -font font_diff \
3960                 -state disabled \
3961                 -yscrollcommand [list $w.m.sby set]
3962         label $w.m.s -text {Working... please wait...} \
3963                 -anchor w \
3964                 -justify left \
3965                 -font font_uibold
3966         scrollbar $w.m.sby -command [list $w.m.t yview]
3967         pack $w.m.l1 -side top -fill x
3968         pack $w.m.s -side bottom -fill x
3969         pack $w.m.sby -side right -fill y
3970         pack $w.m.t -side left -fill both -expand 1
3971         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3972
3973         menu $w.ctxm -tearoff 0
3974         $w.ctxm add command -label "Copy" \
3975                 -font font_ui \
3976                 -command "tk_textCopy $w.m.t"
3977         $w.ctxm add command -label "Select All" \
3978                 -font font_ui \
3979                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3980         $w.ctxm add command -label "Copy All" \
3981                 -font font_ui \
3982                 -command "
3983                         $w.m.t tag add sel 0.0 end
3984                         tk_textCopy $w.m.t
3985                         $w.m.t tag remove sel 0.0 end
3986                 "
3987
3988         button $w.ok -text {Close} \
3989                 -font font_ui \
3990                 -state disabled \
3991                 -command "destroy $w"
3992         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3993
3994         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3995         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3996         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3997         bind $w <Visibility> "focus $w"
3998         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3999         return $w
4000 }
4001
4002 proc console_exec {w cmd after} {
4003         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4004         #    But most users need that so we have to relogin. :-(
4005         #
4006         if {[is_Cygwin]} {
4007                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
4008         }
4009
4010         # -- Tcl won't let us redirect both stdout and stderr to
4011         #    the same pipe.  So pass it through cat...
4012         #
4013         set cmd [concat | $cmd |& cat]
4014
4015         set fd_f [open $cmd r]
4016         fconfigure $fd_f -blocking 0 -translation binary
4017         fileevent $fd_f readable [list console_read $w $fd_f $after]
4018 }
4019
4020 proc console_read {w fd after} {
4021         global console_cr
4022
4023         set buf [read $fd]
4024         if {$buf ne {}} {
4025                 if {![winfo exists $w]} {console_init $w}
4026                 $w.m.t conf -state normal
4027                 set c 0
4028                 set n [string length $buf]
4029                 while {$c < $n} {
4030                         set cr [string first "\r" $buf $c]
4031                         set lf [string first "\n" $buf $c]
4032                         if {$cr < 0} {set cr [expr {$n + 1}]}
4033                         if {$lf < 0} {set lf [expr {$n + 1}]}
4034
4035                         if {$lf < $cr} {
4036                                 $w.m.t insert end [string range $buf $c $lf]
4037                                 set console_cr($w) [$w.m.t index {end -1c}]
4038                                 set c $lf
4039                                 incr c
4040                         } else {
4041                                 $w.m.t delete $console_cr($w) end
4042                                 $w.m.t insert end "\n"
4043                                 $w.m.t insert end [string range $buf $c $cr]
4044                                 set c $cr
4045                                 incr c
4046                         }
4047                 }
4048                 $w.m.t conf -state disabled
4049                 $w.m.t see end
4050         }
4051
4052         fconfigure $fd -blocking 1
4053         if {[eof $fd]} {
4054                 if {[catch {close $fd}]} {
4055                         set ok 0
4056                 } else {
4057                         set ok 1
4058                 }
4059                 uplevel #0 $after $w $ok
4060                 return
4061         }
4062         fconfigure $fd -blocking 0
4063 }
4064
4065 proc console_chain {cmdlist w {ok 1}} {
4066         if {$ok} {
4067                 if {[llength $cmdlist] == 0} {
4068                         console_done $w $ok
4069                         return
4070                 }
4071
4072                 set cmd [lindex $cmdlist 0]
4073                 set cmdlist [lrange $cmdlist 1 end]
4074
4075                 if {[lindex $cmd 0] eq {console_exec}} {
4076                         console_exec $w \
4077                                 [lindex $cmd 1] \
4078                                 [list console_chain $cmdlist]
4079                 } else {
4080                         uplevel #0 $cmd $cmdlist $w $ok
4081                 }
4082         } else {
4083                 console_done $w $ok
4084         }
4085 }
4086
4087 proc console_done {args} {
4088         global console_cr console_data
4089
4090         switch -- [llength $args] {
4091         2 {
4092                 set w [lindex $args 0]
4093                 set ok [lindex $args 1]
4094         }
4095         3 {
4096                 set w [lindex $args 1]
4097                 set ok [lindex $args 2]
4098         }
4099         default {
4100                 error "wrong number of args: console_done ?ignored? w ok"
4101         }
4102         }
4103
4104         if {$ok} {
4105                 if {[winfo exists $w]} {
4106                         $w.m.s conf -background green -text {Success}
4107                         $w.ok conf -state normal
4108                 }
4109         } else {
4110                 if {![winfo exists $w]} {
4111                         console_init $w
4112                 }
4113                 $w.m.s conf -background red -text {Error: Command Failed}
4114                 $w.ok conf -state normal
4115         }
4116
4117         array unset console_cr $w
4118         array unset console_data $w
4119 }
4120
4121 ######################################################################
4122 ##
4123 ## ui commands
4124
4125 set starting_gitk_msg {Starting gitk... please wait...}
4126
4127 proc do_gitk {revs} {
4128         global env ui_status_value starting_gitk_msg
4129
4130         # -- Always start gitk through whatever we were loaded with.  This
4131         #    lets us bypass using shell process on Windows systems.
4132         #
4133         set cmd [info nameofexecutable]
4134         lappend cmd [gitexec gitk]
4135         if {$revs ne {}} {
4136                 append cmd { }
4137                 append cmd $revs
4138         }
4139
4140         if {[catch {eval exec $cmd &} err]} {
4141                 error_popup "Failed to start gitk:\n\n$err"
4142         } else {
4143                 set ui_status_value $starting_gitk_msg
4144                 after 10000 {
4145                         if {$ui_status_value eq $starting_gitk_msg} {
4146                                 set ui_status_value {Ready.}
4147                         }
4148                 }
4149         }
4150 }
4151
4152 proc do_stats {} {
4153         set fd [open "| git count-objects -v" r]
4154         while {[gets $fd line] > 0} {
4155                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4156                         set stats($name) $value
4157                 }
4158         }
4159         close $fd
4160
4161         set packed_sz 0
4162         foreach p [glob -directory [gitdir objects pack] \
4163                 -type f \
4164                 -nocomplain -- *] {
4165                 incr packed_sz [file size $p]
4166         }
4167         if {$packed_sz > 0} {
4168                 set stats(size-pack) [expr {$packed_sz / 1024}]
4169         }
4170
4171         set w .stats_view
4172         toplevel $w
4173         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4174
4175         label $w.header -text {Database Statistics} \
4176                 -font font_uibold
4177         pack $w.header -side top -fill x
4178
4179         frame $w.buttons -border 1
4180         button $w.buttons.close -text Close \
4181                 -font font_ui \
4182                 -command [list destroy $w]
4183         button $w.buttons.gc -text {Compress Database} \
4184                 -font font_ui \
4185                 -command "destroy $w;do_gc"
4186         pack $w.buttons.close -side right
4187         pack $w.buttons.gc -side left
4188         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4189
4190         frame $w.stat -borderwidth 1 -relief solid
4191         foreach s {
4192                 {count           {Number of loose objects}}
4193                 {size            {Disk space used by loose objects} { KiB}}
4194                 {in-pack         {Number of packed objects}}
4195                 {packs           {Number of packs}}
4196                 {size-pack       {Disk space used by packed objects} { KiB}}
4197                 {prune-packable  {Packed objects waiting for pruning}}
4198                 {garbage         {Garbage files}}
4199                 } {
4200                 set name [lindex $s 0]
4201                 set label [lindex $s 1]
4202                 if {[catch {set value $stats($name)}]} continue
4203                 if {[llength $s] > 2} {
4204                         set value "$value[lindex $s 2]"
4205                 }
4206
4207                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4208                 label $w.stat.v_$name -text $value -anchor w -font font_ui
4209                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4210         }
4211         pack $w.stat -pady 10 -padx 10
4212
4213         bind $w <Visibility> "grab $w; focus $w"
4214         bind $w <Key-Escape> [list destroy $w]
4215         bind $w <Key-Return> [list destroy $w]
4216         wm title $w "[appname] ([reponame]): Database Statistics"
4217         tkwait window $w
4218 }
4219
4220 proc do_gc {} {
4221         set w [new_console {gc} {Compressing the object database}]
4222         console_chain {
4223                 {console_exec {git pack-refs --prune}}
4224                 {console_exec {git reflog expire --all}}
4225                 {console_exec {git repack -a -d -l}}
4226                 {console_exec {git rerere gc}}
4227         } $w
4228 }
4229
4230 proc do_fsck_objects {} {
4231         set w [new_console {fsck-objects} \
4232                 {Verifying the object database with fsck-objects}]
4233         set cmd [list git fsck-objects]
4234         lappend cmd --full
4235         lappend cmd --cache
4236         lappend cmd --strict
4237         console_exec $w $cmd console_done
4238 }
4239
4240 set is_quitting 0
4241
4242 proc do_quit {} {
4243         global ui_comm is_quitting repo_config commit_type
4244
4245         if {$is_quitting} return
4246         set is_quitting 1
4247
4248         if {[winfo exists $ui_comm]} {
4249                 # -- Stash our current commit buffer.
4250                 #
4251                 set save [gitdir GITGUI_MSG]
4252                 set msg [string trim [$ui_comm get 0.0 end]]
4253                 regsub -all -line {[ \r\t]+$} $msg {} msg
4254                 if {(![string match amend* $commit_type]
4255                         || [$ui_comm edit modified])
4256                         && $msg ne {}} {
4257                         catch {
4258                                 set fd [open $save w]
4259                                 puts -nonewline $fd $msg
4260                                 close $fd
4261                         }
4262                 } else {
4263                         catch {file delete $save}
4264                 }
4265
4266                 # -- Stash our current window geometry into this repository.
4267                 #
4268                 set cfg_geometry [list]
4269                 lappend cfg_geometry [wm geometry .]
4270                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4271                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4272                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4273                         set rc_geometry {}
4274                 }
4275                 if {$cfg_geometry ne $rc_geometry} {
4276                         catch {git config gui.geometry $cfg_geometry}
4277                 }
4278         }
4279
4280         destroy .
4281 }
4282
4283 proc do_rescan {} {
4284         rescan {set ui_status_value {Ready.}}
4285 }
4286
4287 proc unstage_helper {txt paths} {
4288         global file_states current_diff_path
4289
4290         if {![lock_index begin-update]} return
4291
4292         set pathList [list]
4293         set after {}
4294         foreach path $paths {
4295                 switch -glob -- [lindex $file_states($path) 0] {
4296                 A? -
4297                 M? -
4298                 D? {
4299                         lappend pathList $path
4300                         if {$path eq $current_diff_path} {
4301                                 set after {reshow_diff;}
4302                         }
4303                 }
4304                 }
4305         }
4306         if {$pathList eq {}} {
4307                 unlock_index
4308         } else {
4309                 update_indexinfo \
4310                         $txt \
4311                         $pathList \
4312                         [concat $after {set ui_status_value {Ready.}}]
4313         }
4314 }
4315
4316 proc do_unstage_selection {} {
4317         global current_diff_path selected_paths
4318
4319         if {[array size selected_paths] > 0} {
4320                 unstage_helper \
4321                         {Unstaging selected files from commit} \
4322                         [array names selected_paths]
4323         } elseif {$current_diff_path ne {}} {
4324                 unstage_helper \
4325                         "Unstaging [short_path $current_diff_path] from commit" \
4326                         [list $current_diff_path]
4327         }
4328 }
4329
4330 proc add_helper {txt paths} {
4331         global file_states current_diff_path
4332
4333         if {![lock_index begin-update]} return
4334
4335         set pathList [list]
4336         set after {}
4337         foreach path $paths {
4338                 switch -glob -- [lindex $file_states($path) 0] {
4339                 _O -
4340                 ?M -
4341                 ?D -
4342                 U? {
4343                         lappend pathList $path
4344                         if {$path eq $current_diff_path} {
4345                                 set after {reshow_diff;}
4346                         }
4347                 }
4348                 }
4349         }
4350         if {$pathList eq {}} {
4351                 unlock_index
4352         } else {
4353                 update_index \
4354                         $txt \
4355                         $pathList \
4356                         [concat $after {set ui_status_value {Ready to commit.}}]
4357         }
4358 }
4359
4360 proc do_add_selection {} {
4361         global current_diff_path selected_paths
4362
4363         if {[array size selected_paths] > 0} {
4364                 add_helper \
4365                         {Adding selected files} \
4366                         [array names selected_paths]
4367         } elseif {$current_diff_path ne {}} {
4368                 add_helper \
4369                         "Adding [short_path $current_diff_path]" \
4370                         [list $current_diff_path]
4371         }
4372 }
4373
4374 proc do_add_all {} {
4375         global file_states
4376
4377         set paths [list]
4378         foreach path [array names file_states] {
4379                 switch -glob -- [lindex $file_states($path) 0] {
4380                 U? {continue}
4381                 ?M -
4382                 ?D {lappend paths $path}
4383                 }
4384         }
4385         add_helper {Adding all changed files} $paths
4386 }
4387
4388 proc revert_helper {txt paths} {
4389         global file_states current_diff_path
4390
4391         if {![lock_index begin-update]} return
4392
4393         set pathList [list]
4394         set after {}
4395         foreach path $paths {
4396                 switch -glob -- [lindex $file_states($path) 0] {
4397                 U? {continue}
4398                 ?M -
4399                 ?D {
4400                         lappend pathList $path
4401                         if {$path eq $current_diff_path} {
4402                                 set after {reshow_diff;}
4403                         }
4404                 }
4405                 }
4406         }
4407
4408         set n [llength $pathList]
4409         if {$n == 0} {
4410                 unlock_index
4411                 return
4412         } elseif {$n == 1} {
4413                 set s "[short_path [lindex $pathList]]"
4414         } else {
4415                 set s "these $n files"
4416         }
4417
4418         set reply [tk_dialog \
4419                 .confirm_revert \
4420                 "[appname] ([reponame])" \
4421                 "Revert changes in $s?
4422
4423 Any unadded changes will be permanently lost by the revert." \
4424                 question \
4425                 1 \
4426                 {Do Nothing} \
4427                 {Revert Changes} \
4428                 ]
4429         if {$reply == 1} {
4430                 checkout_index \
4431                         $txt \
4432                         $pathList \
4433                         [concat $after {set ui_status_value {Ready.}}]
4434         } else {
4435                 unlock_index
4436         }
4437 }
4438
4439 proc do_revert_selection {} {
4440         global current_diff_path selected_paths
4441
4442         if {[array size selected_paths] > 0} {
4443                 revert_helper \
4444                         {Reverting selected files} \
4445                         [array names selected_paths]
4446         } elseif {$current_diff_path ne {}} {
4447                 revert_helper \
4448                         "Reverting [short_path $current_diff_path]" \
4449                         [list $current_diff_path]
4450         }
4451 }
4452
4453 proc do_signoff {} {
4454         global ui_comm
4455
4456         set me [committer_ident]
4457         if {$me eq {}} return
4458
4459         set sob "Signed-off-by: $me"
4460         set last [$ui_comm get {end -1c linestart} {end -1c}]
4461         if {$last ne $sob} {
4462                 $ui_comm edit separator
4463                 if {$last ne {}
4464                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4465                         $ui_comm insert end "\n"
4466                 }
4467                 $ui_comm insert end "\n$sob"
4468                 $ui_comm edit separator
4469                 $ui_comm see end
4470         }
4471 }
4472
4473 proc do_select_commit_type {} {
4474         global commit_type selected_commit_type
4475
4476         if {$selected_commit_type eq {new}
4477                 && [string match amend* $commit_type]} {
4478                 create_new_commit
4479         } elseif {$selected_commit_type eq {amend}
4480                 && ![string match amend* $commit_type]} {
4481                 load_last_commit
4482
4483                 # The amend request was rejected...
4484                 #
4485                 if {![string match amend* $commit_type]} {
4486                         set selected_commit_type new
4487                 }
4488         }
4489 }
4490
4491 proc do_commit {} {
4492         commit_tree
4493 }
4494
4495 proc do_credits {} {
4496         global gitgui_credits
4497
4498         set w .credits_dialog
4499
4500         toplevel $w
4501         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4502
4503         label $w.header -text {git-gui Contributors} -font font_uibold
4504         pack $w.header -side top -fill x
4505
4506         frame $w.buttons
4507         button $w.buttons.close -text {Close} \
4508                 -font font_ui \
4509                 -command [list destroy $w]
4510         pack $w.buttons.close -side right
4511         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4512
4513         frame $w.credits
4514         text $w.credits.t \
4515                 -background [$w.header cget -background] \
4516                 -yscrollcommand [list $w.credits.sby set] \
4517                 -width 20 \
4518                 -height 10 \
4519                 -wrap none \
4520                 -borderwidth 1 \
4521                 -relief solid \
4522                 -padx 5 -pady 5 \
4523                 -font font_ui
4524         scrollbar $w.credits.sby -command [list $w.credits.t yview]
4525         pack $w.credits.sby -side right -fill y
4526         pack $w.credits.t -fill both -expand 1
4527         pack $w.credits -side top -fill both -expand 1 -padx 5 -pady 5
4528
4529         label $w.desc \
4530                 -text "All portions are copyrighted by their respective authors
4531 and are distributed under the GNU General Public License." \
4532                 -padx 5 -pady 5 \
4533                 -justify left \
4534                 -anchor w \
4535                 -borderwidth 1 \
4536                 -relief solid \
4537                 -font font_ui
4538         pack $w.desc -side top -fill x -padx 5 -pady 5
4539
4540         $w.credits.t insert end "[string trim $gitgui_credits]\n"
4541         $w.credits.t conf -state disabled
4542         $w.credits.t see 1.0
4543
4544         bind $w <Visibility> "grab $w; focus $w"
4545         bind $w <Key-Escape> [list destroy $w]
4546         wm title $w [$w.header cget -text]
4547         tkwait window $w
4548 }
4549
4550 proc do_about {} {
4551         global appvers copyright
4552         global tcl_patchLevel tk_patchLevel
4553
4554         set w .about_dialog
4555         toplevel $w
4556         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4557
4558         label $w.header -text "About [appname]" \
4559                 -font font_uibold
4560         pack $w.header -side top -fill x
4561
4562         frame $w.buttons
4563         button $w.buttons.close -text {Close} \
4564                 -font font_ui \
4565                 -command [list destroy $w]
4566         button $w.buttons.credits -text {Contributors} \
4567                 -font font_ui \
4568                 -command do_credits
4569         pack $w.buttons.credits -side left
4570         pack $w.buttons.close -side right
4571         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4572
4573         label $w.desc \
4574                 -text "git-gui - a graphical user interface for Git.
4575 $copyright" \
4576                 -padx 5 -pady 5 \
4577                 -justify left \
4578                 -anchor w \
4579                 -borderwidth 1 \
4580                 -relief solid \
4581                 -font font_ui
4582         pack $w.desc -side top -fill x -padx 5 -pady 5
4583
4584         set v {}
4585         append v "git-gui version $appvers\n"
4586         append v "[git version]\n"
4587         append v "\n"
4588         if {$tcl_patchLevel eq $tk_patchLevel} {
4589                 append v "Tcl/Tk version $tcl_patchLevel"
4590         } else {
4591                 append v "Tcl version $tcl_patchLevel"
4592                 append v ", Tk version $tk_patchLevel"
4593         }
4594
4595         label $w.vers \
4596                 -text $v \
4597                 -padx 5 -pady 5 \
4598                 -justify left \
4599                 -anchor w \
4600                 -borderwidth 1 \
4601                 -relief solid \
4602                 -font font_ui
4603         pack $w.vers -side top -fill x -padx 5 -pady 5
4604
4605         menu $w.ctxm -tearoff 0
4606         $w.ctxm add command \
4607                 -label {Copy} \
4608                 -font font_ui \
4609                 -command "
4610                 clipboard clear
4611                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4612         "
4613
4614         bind $w <Visibility> "grab $w; focus $w"
4615         bind $w <Key-Escape> "destroy $w"
4616         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4617         wm title $w "About [appname]"
4618         tkwait window $w
4619 }
4620
4621 proc do_options {} {
4622         global repo_config global_config font_descs
4623         global repo_config_new global_config_new
4624
4625         array unset repo_config_new
4626         array unset global_config_new
4627         foreach name [array names repo_config] {
4628                 set repo_config_new($name) $repo_config($name)
4629         }
4630         load_config 1
4631         foreach name [array names repo_config] {
4632                 switch -- $name {
4633                 gui.diffcontext {continue}
4634                 }
4635                 set repo_config_new($name) $repo_config($name)
4636         }
4637         foreach name [array names global_config] {
4638                 set global_config_new($name) $global_config($name)
4639         }
4640
4641         set w .options_editor
4642         toplevel $w
4643         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4644
4645         label $w.header -text "Options" \
4646                 -font font_uibold
4647         pack $w.header -side top -fill x
4648
4649         frame $w.buttons
4650         button $w.buttons.restore -text {Restore Defaults} \
4651                 -font font_ui \
4652                 -command do_restore_defaults
4653         pack $w.buttons.restore -side left
4654         button $w.buttons.save -text Save \
4655                 -font font_ui \
4656                 -command [list do_save_config $w]
4657         pack $w.buttons.save -side right
4658         button $w.buttons.cancel -text {Cancel} \
4659                 -font font_ui \
4660                 -command [list destroy $w]
4661         pack $w.buttons.cancel -side right -padx 5
4662         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4663
4664         labelframe $w.repo -text "[reponame] Repository" \
4665                 -font font_ui
4666         labelframe $w.global -text {Global (All Repositories)} \
4667                 -font font_ui
4668         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4669         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4670
4671         set optid 0
4672         foreach option {
4673                 {t user.name {User Name}}
4674                 {t user.email {Email Address}}
4675
4676                 {b merge.summary {Summarize Merge Commits}}
4677                 {i-1..5 merge.verbosity {Merge Verbosity}}
4678
4679                 {b gui.trustmtime  {Trust File Modification Timestamps}}
4680                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4681                 {t gui.newbranchtemplate {New Branch Name Template}}
4682                 } {
4683                 set type [lindex $option 0]
4684                 set name [lindex $option 1]
4685                 set text [lindex $option 2]
4686                 incr optid
4687                 foreach f {repo global} {
4688                         switch -glob -- $type {
4689                         b {
4690                                 checkbutton $w.$f.$optid -text $text \
4691                                         -variable ${f}_config_new($name) \
4692                                         -onvalue true \
4693                                         -offvalue false \
4694                                         -font font_ui
4695                                 pack $w.$f.$optid -side top -anchor w
4696                         }
4697                         i-* {
4698                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4699                                 frame $w.$f.$optid
4700                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4701                                 pack $w.$f.$optid.l -side left -anchor w -fill x
4702                                 spinbox $w.$f.$optid.v \
4703                                         -textvariable ${f}_config_new($name) \
4704                                         -from $min \
4705                                         -to $max \
4706                                         -increment 1 \
4707                                         -width [expr {1 + [string length $max]}] \
4708                                         -font font_ui
4709                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4710                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
4711                                 pack $w.$f.$optid -side top -anchor w -fill x
4712                         }
4713                         t {
4714                                 frame $w.$f.$optid
4715                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4716                                 entry $w.$f.$optid.v \
4717                                         -borderwidth 1 \
4718                                         -relief sunken \
4719                                         -width 20 \
4720                                         -textvariable ${f}_config_new($name) \
4721                                         -font font_ui
4722                                 pack $w.$f.$optid.l -side left -anchor w
4723                                 pack $w.$f.$optid.v -side left -anchor w \
4724                                         -fill x -expand 1 \
4725                                         -padx 5
4726                                 pack $w.$f.$optid -side top -anchor w -fill x
4727                         }
4728                         }
4729                 }
4730         }
4731
4732         set all_fonts [lsort [font families]]
4733         foreach option $font_descs {
4734                 set name [lindex $option 0]
4735                 set font [lindex $option 1]
4736                 set text [lindex $option 2]
4737
4738                 set global_config_new(gui.$font^^family) \
4739                         [font configure $font -family]
4740                 set global_config_new(gui.$font^^size) \
4741                         [font configure $font -size]
4742
4743                 frame $w.global.$name
4744                 label $w.global.$name.l -text "$text:" -font font_ui
4745                 pack $w.global.$name.l -side left -anchor w -fill x
4746                 eval tk_optionMenu $w.global.$name.family \
4747                         global_config_new(gui.$font^^family) \
4748                         $all_fonts
4749                 spinbox $w.global.$name.size \
4750                         -textvariable global_config_new(gui.$font^^size) \
4751                         -from 2 -to 80 -increment 1 \
4752                         -width 3 \
4753                         -font font_ui
4754                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4755                 pack $w.global.$name.size -side right -anchor e
4756                 pack $w.global.$name.family -side right -anchor e
4757                 pack $w.global.$name -side top -anchor w -fill x
4758         }
4759
4760         bind $w <Visibility> "grab $w; focus $w"
4761         bind $w <Key-Escape> "destroy $w"
4762         wm title $w "[appname] ([reponame]): Options"
4763         tkwait window $w
4764 }
4765
4766 proc do_restore_defaults {} {
4767         global font_descs default_config repo_config
4768         global repo_config_new global_config_new
4769
4770         foreach name [array names default_config] {
4771                 set repo_config_new($name) $default_config($name)
4772                 set global_config_new($name) $default_config($name)
4773         }
4774
4775         foreach option $font_descs {
4776                 set name [lindex $option 0]
4777                 set repo_config(gui.$name) $default_config(gui.$name)
4778         }
4779         apply_config
4780
4781         foreach option $font_descs {
4782                 set name [lindex $option 0]
4783                 set font [lindex $option 1]
4784                 set global_config_new(gui.$font^^family) \
4785                         [font configure $font -family]
4786                 set global_config_new(gui.$font^^size) \
4787                         [font configure $font -size]
4788         }
4789 }
4790
4791 proc do_save_config {w} {
4792         if {[catch {save_config} err]} {
4793                 error_popup "Failed to completely save options:\n\n$err"
4794         }
4795         reshow_diff
4796         destroy $w
4797 }
4798
4799 proc do_windows_shortcut {} {
4800         global argv0
4801
4802         set fn [tk_getSaveFile \
4803                 -parent . \
4804                 -title "[appname] ([reponame]): Create Desktop Icon" \
4805                 -initialfile "Git [reponame].bat"]
4806         if {$fn != {}} {
4807                 if {[catch {
4808                                 set fd [open $fn w]
4809                                 puts $fd "@ECHO Entering [reponame]"
4810                                 puts $fd "@ECHO Starting git-gui... please wait..."
4811                                 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4812                                 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4813                                 puts -nonewline $fd "@\"[info nameofexecutable]\""
4814                                 puts $fd " \"[file normalize $argv0]\""
4815                                 close $fd
4816                         } err]} {
4817                         error_popup "Cannot write script:\n\n$err"
4818                 }
4819         }
4820 }
4821
4822 proc do_cygwin_shortcut {} {
4823         global argv0
4824
4825         if {[catch {
4826                 set desktop [exec cygpath \
4827                         --windows \
4828                         --absolute \
4829                         --long-name \
4830                         --desktop]
4831                 }]} {
4832                         set desktop .
4833         }
4834         set fn [tk_getSaveFile \
4835                 -parent . \
4836                 -title "[appname] ([reponame]): Create Desktop Icon" \
4837                 -initialdir $desktop \
4838                 -initialfile "Git [reponame].bat"]
4839         if {$fn != {}} {
4840                 if {[catch {
4841                                 set fd [open $fn w]
4842                                 set sh [exec cygpath \
4843                                         --windows \
4844                                         --absolute \
4845                                         /bin/sh]
4846                                 set me [exec cygpath \
4847                                         --unix \
4848                                         --absolute \
4849                                         $argv0]
4850                                 set gd [exec cygpath \
4851                                         --unix \
4852                                         --absolute \
4853                                         [gitdir]]
4854                                 set gw [exec cygpath \
4855                                         --windows \
4856                                         --absolute \
4857                                         [file dirname [gitdir]]]
4858                                 regsub -all ' $me "'\\''" me
4859                                 regsub -all ' $gd "'\\''" gd
4860                                 puts $fd "@ECHO Entering $gw"
4861                                 puts $fd "@ECHO Starting git-gui... please wait..."
4862                                 puts -nonewline $fd "@\"$sh\" --login -c \""
4863                                 puts -nonewline $fd "GIT_DIR='$gd'"
4864                                 puts -nonewline $fd " '$me'"
4865                                 puts $fd "&\""
4866                                 close $fd
4867                         } err]} {
4868                         error_popup "Cannot write script:\n\n$err"
4869                 }
4870         }
4871 }
4872
4873 proc do_macosx_app {} {
4874         global argv0 env
4875
4876         set fn [tk_getSaveFile \
4877                 -parent . \
4878                 -title "[appname] ([reponame]): Create Desktop Icon" \
4879                 -initialdir [file join $env(HOME) Desktop] \
4880                 -initialfile "Git [reponame].app"]
4881         if {$fn != {}} {
4882                 if {[catch {
4883                                 set Contents [file join $fn Contents]
4884                                 set MacOS [file join $Contents MacOS]
4885                                 set exe [file join $MacOS git-gui]
4886
4887                                 file mkdir $MacOS
4888
4889                                 set fd [open [file join $Contents Info.plist] w]
4890                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4891 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4892 <plist version="1.0">
4893 <dict>
4894         <key>CFBundleDevelopmentRegion</key>
4895         <string>English</string>
4896         <key>CFBundleExecutable</key>
4897         <string>git-gui</string>
4898         <key>CFBundleIdentifier</key>
4899         <string>org.spearce.git-gui</string>
4900         <key>CFBundleInfoDictionaryVersion</key>
4901         <string>6.0</string>
4902         <key>CFBundlePackageType</key>
4903         <string>APPL</string>
4904         <key>CFBundleSignature</key>
4905         <string>????</string>
4906         <key>CFBundleVersion</key>
4907         <string>1.0</string>
4908         <key>NSPrincipalClass</key>
4909         <string>NSApplication</string>
4910 </dict>
4911 </plist>}
4912                                 close $fd
4913
4914                                 set fd [open $exe w]
4915                                 set gd [file normalize [gitdir]]
4916                                 set ep [file normalize [gitexec]]
4917                                 regsub -all ' $gd "'\\''" gd
4918                                 regsub -all ' $ep "'\\''" ep
4919                                 puts $fd "#!/bin/sh"
4920                                 foreach name [array names env] {
4921                                         if {[string match GIT_* $name]} {
4922                                                 regsub -all ' $env($name) "'\\''" v
4923                                                 puts $fd "export $name='$v'"
4924                                         }
4925                                 }
4926                                 puts $fd "export PATH='$ep':\$PATH"
4927                                 puts $fd "export GIT_DIR='$gd'"
4928                                 puts $fd "exec [file normalize $argv0]"
4929                                 close $fd
4930
4931                                 file attributes $exe -permissions u+x,g+x,o+x
4932                         } err]} {
4933                         error_popup "Cannot write icon:\n\n$err"
4934                 }
4935         }
4936 }
4937
4938 proc toggle_or_diff {w x y} {
4939         global file_states file_lists current_diff_path ui_index ui_workdir
4940         global last_clicked selected_paths
4941
4942         set pos [split [$w index @$x,$y] .]
4943         set lno [lindex $pos 0]
4944         set col [lindex $pos 1]
4945         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4946         if {$path eq {}} {
4947                 set last_clicked {}
4948                 return
4949         }
4950
4951         set last_clicked [list $w $lno]
4952         array unset selected_paths
4953         $ui_index tag remove in_sel 0.0 end
4954         $ui_workdir tag remove in_sel 0.0 end
4955
4956         if {$col == 0} {
4957                 if {$current_diff_path eq $path} {
4958                         set after {reshow_diff;}
4959                 } else {
4960                         set after {}
4961                 }
4962                 if {$w eq $ui_index} {
4963                         update_indexinfo \
4964                                 "Unstaging [short_path $path] from commit" \
4965                                 [list $path] \
4966                                 [concat $after {set ui_status_value {Ready.}}]
4967                 } elseif {$w eq $ui_workdir} {
4968                         update_index \
4969                                 "Adding [short_path $path]" \
4970                                 [list $path] \
4971                                 [concat $after {set ui_status_value {Ready.}}]
4972                 }
4973         } else {
4974                 show_diff $path $w $lno
4975         }
4976 }
4977
4978 proc add_one_to_selection {w x y} {
4979         global file_lists last_clicked selected_paths
4980
4981         set lno [lindex [split [$w index @$x,$y] .] 0]
4982         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4983         if {$path eq {}} {
4984                 set last_clicked {}
4985                 return
4986         }
4987
4988         if {$last_clicked ne {}
4989                 && [lindex $last_clicked 0] ne $w} {
4990                 array unset selected_paths
4991                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4992         }
4993
4994         set last_clicked [list $w $lno]
4995         if {[catch {set in_sel $selected_paths($path)}]} {
4996                 set in_sel 0
4997         }
4998         if {$in_sel} {
4999                 unset selected_paths($path)
5000                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
5001         } else {
5002                 set selected_paths($path) 1
5003                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
5004         }
5005 }
5006
5007 proc add_range_to_selection {w x y} {
5008         global file_lists last_clicked selected_paths
5009
5010         if {[lindex $last_clicked 0] ne $w} {
5011                 toggle_or_diff $w $x $y
5012                 return
5013         }
5014
5015         set lno [lindex [split [$w index @$x,$y] .] 0]
5016         set lc [lindex $last_clicked 1]
5017         if {$lc < $lno} {
5018                 set begin $lc
5019                 set end $lno
5020         } else {
5021                 set begin $lno
5022                 set end $lc
5023         }
5024
5025         foreach path [lrange $file_lists($w) \
5026                 [expr {$begin - 1}] \
5027                 [expr {$end - 1}]] {
5028                 set selected_paths($path) 1
5029         }
5030         $w tag add in_sel $begin.0 [expr {$end + 1}].0
5031 }
5032
5033 ######################################################################
5034 ##
5035 ## config defaults
5036
5037 set cursor_ptr arrow
5038 font create font_diff -family Courier -size 10
5039 font create font_ui
5040 catch {
5041         label .dummy
5042         eval font configure font_ui [font actual [.dummy cget -font]]
5043         destroy .dummy
5044 }
5045
5046 font create font_uibold
5047 font create font_diffbold
5048
5049 if {[is_Windows]} {
5050         set M1B Control
5051         set M1T Ctrl
5052 } elseif {[is_MacOSX]} {
5053         set M1B M1
5054         set M1T Cmd
5055 } else {
5056         set M1B M1
5057         set M1T M1
5058 }
5059
5060 proc apply_config {} {
5061         global repo_config font_descs
5062
5063         foreach option $font_descs {
5064                 set name [lindex $option 0]
5065                 set font [lindex $option 1]
5066                 if {[catch {
5067                         foreach {cn cv} $repo_config(gui.$name) {
5068                                 font configure $font $cn $cv
5069                         }
5070                         } err]} {
5071                         error_popup "Invalid font specified in gui.$name:\n\n$err"
5072                 }
5073                 foreach {cn cv} [font configure $font] {
5074                         font configure ${font}bold $cn $cv
5075                 }
5076                 font configure ${font}bold -weight bold
5077         }
5078 }
5079
5080 set default_config(merge.summary) false
5081 set default_config(merge.verbosity) 2
5082 set default_config(user.name) {}
5083 set default_config(user.email) {}
5084
5085 set default_config(gui.trustmtime) false
5086 set default_config(gui.diffcontext) 5
5087 set default_config(gui.newbranchtemplate) {}
5088 set default_config(gui.fontui) [font configure font_ui]
5089 set default_config(gui.fontdiff) [font configure font_diff]
5090 set font_descs {
5091         {fontui   font_ui   {Main Font}}
5092         {fontdiff font_diff {Diff/Console Font}}
5093 }
5094 load_config 0
5095 apply_config
5096
5097 ######################################################################
5098 ##
5099 ## feature option selection
5100
5101 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5102         unset _junk
5103 } else {
5104         set subcommand gui
5105 }
5106 if {$subcommand eq {gui.sh}} {
5107         set subcommand gui
5108 }
5109 if {$subcommand eq {gui} && [llength $argv] > 0} {
5110         set subcommand [lindex $argv 0]
5111         set argv [lrange $argv 1 end]
5112 }
5113
5114 enable_option multicommit
5115 enable_option branch
5116 enable_option transport
5117
5118 switch -- $subcommand {
5119 --version -
5120 version -
5121 browser -
5122 blame {
5123         disable_option multicommit
5124         disable_option branch
5125         disable_option transport
5126 }
5127 citool {
5128         enable_option singlecommit
5129
5130         disable_option multicommit
5131         disable_option branch
5132         disable_option transport
5133 }
5134 }
5135
5136 ######################################################################
5137 ##
5138 ## ui construction
5139
5140 set ui_comm {}
5141
5142 # -- Menu Bar
5143 #
5144 menu .mbar -tearoff 0
5145 .mbar add cascade -label Repository -menu .mbar.repository
5146 .mbar add cascade -label Edit -menu .mbar.edit
5147 if {[is_enabled branch]} {
5148         .mbar add cascade -label Branch -menu .mbar.branch
5149 }
5150 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5151         .mbar add cascade -label Commit -menu .mbar.commit
5152 }
5153 if {[is_enabled transport]} {
5154         .mbar add cascade -label Merge -menu .mbar.merge
5155         .mbar add cascade -label Fetch -menu .mbar.fetch
5156         .mbar add cascade -label Push -menu .mbar.push
5157 }
5158 . configure -menu .mbar
5159
5160 # -- Repository Menu
5161 #
5162 menu .mbar.repository
5163
5164 .mbar.repository add command \
5165         -label {Browse Current Branch} \
5166         -command {new_browser $current_branch} \
5167         -font font_ui
5168 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
5169 .mbar.repository add separator
5170
5171 .mbar.repository add command \
5172         -label {Visualize Current Branch} \
5173         -command {do_gitk $current_branch} \
5174         -font font_ui
5175 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5176 .mbar.repository add command \
5177         -label {Visualize All Branches} \
5178         -command {do_gitk --all} \
5179         -font font_ui
5180 .mbar.repository add separator
5181
5182 if {[is_enabled multicommit]} {
5183         .mbar.repository add command -label {Database Statistics} \
5184                 -command do_stats \
5185                 -font font_ui
5186
5187         .mbar.repository add command -label {Compress Database} \
5188                 -command do_gc \
5189                 -font font_ui
5190
5191         .mbar.repository add command -label {Verify Database} \
5192                 -command do_fsck_objects \
5193                 -font font_ui
5194
5195         .mbar.repository add separator
5196
5197         if {[is_Cygwin]} {
5198                 .mbar.repository add command \
5199                         -label {Create Desktop Icon} \
5200                         -command do_cygwin_shortcut \
5201                         -font font_ui
5202         } elseif {[is_Windows]} {
5203                 .mbar.repository add command \
5204                         -label {Create Desktop Icon} \
5205                         -command do_windows_shortcut \
5206                         -font font_ui
5207         } elseif {[is_MacOSX]} {
5208                 .mbar.repository add command \
5209                         -label {Create Desktop Icon} \
5210                         -command do_macosx_app \
5211                         -font font_ui
5212         }
5213 }
5214
5215 .mbar.repository add command -label Quit \
5216         -command do_quit \
5217         -accelerator $M1T-Q \
5218         -font font_ui
5219
5220 # -- Edit Menu
5221 #
5222 menu .mbar.edit
5223 .mbar.edit add command -label Undo \
5224         -command {catch {[focus] edit undo}} \
5225         -accelerator $M1T-Z \
5226         -font font_ui
5227 .mbar.edit add command -label Redo \
5228         -command {catch {[focus] edit redo}} \
5229         -accelerator $M1T-Y \
5230         -font font_ui
5231 .mbar.edit add separator
5232 .mbar.edit add command -label Cut \
5233         -command {catch {tk_textCut [focus]}} \
5234         -accelerator $M1T-X \
5235         -font font_ui
5236 .mbar.edit add command -label Copy \
5237         -command {catch {tk_textCopy [focus]}} \
5238         -accelerator $M1T-C \
5239         -font font_ui
5240 .mbar.edit add command -label Paste \
5241         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5242         -accelerator $M1T-V \
5243         -font font_ui
5244 .mbar.edit add command -label Delete \
5245         -command {catch {[focus] delete sel.first sel.last}} \
5246         -accelerator Del \
5247         -font font_ui
5248 .mbar.edit add separator
5249 .mbar.edit add command -label {Select All} \
5250         -command {catch {[focus] tag add sel 0.0 end}} \
5251         -accelerator $M1T-A \
5252         -font font_ui
5253
5254 # -- Branch Menu
5255 #
5256 if {[is_enabled branch]} {
5257         menu .mbar.branch
5258
5259         .mbar.branch add command -label {Create...} \
5260                 -command do_create_branch \
5261                 -accelerator $M1T-N \
5262                 -font font_ui
5263         lappend disable_on_lock [list .mbar.branch entryconf \
5264                 [.mbar.branch index last] -state]
5265
5266         .mbar.branch add command -label {Delete...} \
5267                 -command do_delete_branch \
5268                 -font font_ui
5269         lappend disable_on_lock [list .mbar.branch entryconf \
5270                 [.mbar.branch index last] -state]
5271
5272         .mbar.branch add command -label {Reset...} \
5273                 -command do_reset_hard \
5274                 -font font_ui
5275         lappend disable_on_lock [list .mbar.branch entryconf \
5276                 [.mbar.branch index last] -state]
5277 }
5278
5279 # -- Commit Menu
5280 #
5281 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5282         menu .mbar.commit
5283
5284         .mbar.commit add radiobutton \
5285                 -label {New Commit} \
5286                 -command do_select_commit_type \
5287                 -variable selected_commit_type \
5288                 -value new \
5289                 -font font_ui
5290         lappend disable_on_lock \
5291                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5292
5293         .mbar.commit add radiobutton \
5294                 -label {Amend Last Commit} \
5295                 -command do_select_commit_type \
5296                 -variable selected_commit_type \
5297                 -value amend \
5298                 -font font_ui
5299         lappend disable_on_lock \
5300                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5301
5302         .mbar.commit add separator
5303
5304         .mbar.commit add command -label Rescan \
5305                 -command do_rescan \
5306                 -accelerator F5 \
5307                 -font font_ui
5308         lappend disable_on_lock \
5309                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5310
5311         .mbar.commit add command -label {Add To Commit} \
5312                 -command do_add_selection \
5313                 -font font_ui
5314         lappend disable_on_lock \
5315                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5316
5317         .mbar.commit add command -label {Add Existing To Commit} \
5318                 -command do_add_all \
5319                 -accelerator $M1T-I \
5320                 -font font_ui
5321         lappend disable_on_lock \
5322                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5323
5324         .mbar.commit add command -label {Unstage From Commit} \
5325                 -command do_unstage_selection \
5326                 -font font_ui
5327         lappend disable_on_lock \
5328                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5329
5330         .mbar.commit add command -label {Revert Changes} \
5331                 -command do_revert_selection \
5332                 -font font_ui
5333         lappend disable_on_lock \
5334                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5335
5336         .mbar.commit add separator
5337
5338         .mbar.commit add command -label {Sign Off} \
5339                 -command do_signoff \
5340                 -accelerator $M1T-S \
5341                 -font font_ui
5342
5343         .mbar.commit add command -label Commit \
5344                 -command do_commit \
5345                 -accelerator $M1T-Return \
5346                 -font font_ui
5347         lappend disable_on_lock \
5348                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5349 }
5350
5351 # -- Merge Menu
5352 #
5353 if {[is_enabled branch]} {
5354         menu .mbar.merge
5355         .mbar.merge add command -label {Local Merge...} \
5356                 -command do_local_merge \
5357                 -font font_ui
5358         lappend disable_on_lock \
5359                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5360         .mbar.merge add command -label {Abort Merge...} \
5361                 -command do_reset_hard \
5362                 -font font_ui
5363         lappend disable_on_lock \
5364                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5365
5366 }
5367
5368 # -- Transport Menu
5369 #
5370 if {[is_enabled transport]} {
5371         menu .mbar.fetch
5372
5373         menu .mbar.push
5374         .mbar.push add command -label {Push...} \
5375                 -command do_push_anywhere \
5376                 -font font_ui
5377 }
5378
5379 if {[is_MacOSX]} {
5380         # -- Apple Menu (Mac OS X only)
5381         #
5382         .mbar add cascade -label Apple -menu .mbar.apple
5383         menu .mbar.apple
5384
5385         .mbar.apple add command -label "About [appname]" \
5386                 -command do_about \
5387                 -font font_ui
5388         .mbar.apple add command -label "Options..." \
5389                 -command do_options \
5390                 -font font_ui
5391 } else {
5392         # -- Edit Menu
5393         #
5394         .mbar.edit add separator
5395         .mbar.edit add command -label {Options...} \
5396                 -command do_options \
5397                 -font font_ui
5398
5399         # -- Tools Menu
5400         #
5401         if {[file exists /usr/local/miga/lib/gui-miga]
5402                 && [file exists .pvcsrc]} {
5403         proc do_miga {} {
5404                 global ui_status_value
5405                 if {![lock_index update]} return
5406                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5407                 set miga_fd [open "|$cmd" r]
5408                 fconfigure $miga_fd -blocking 0
5409                 fileevent $miga_fd readable [list miga_done $miga_fd]
5410                 set ui_status_value {Running miga...}
5411         }
5412         proc miga_done {fd} {
5413                 read $fd 512
5414                 if {[eof $fd]} {
5415                         close $fd
5416                         unlock_index
5417                         rescan [list set ui_status_value {Ready.}]
5418                 }
5419         }
5420         .mbar add cascade -label Tools -menu .mbar.tools
5421         menu .mbar.tools
5422         .mbar.tools add command -label "Migrate" \
5423                 -command do_miga \
5424                 -font font_ui
5425         lappend disable_on_lock \
5426                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5427         }
5428 }
5429
5430 # -- Help Menu
5431 #
5432 .mbar add cascade -label Help -menu .mbar.help
5433 menu .mbar.help
5434
5435 if {![is_MacOSX]} {
5436         .mbar.help add command -label "About [appname]" \
5437                 -command do_about \
5438                 -font font_ui
5439 }
5440
5441 set browser {}
5442 catch {set browser $repo_config(instaweb.browser)}
5443 set doc_path [file dirname [gitexec]]
5444 set doc_path [file join $doc_path Documentation index.html]
5445
5446 if {[is_Cygwin]} {
5447         set doc_path [exec cygpath --mixed $doc_path]
5448 }
5449
5450 if {$browser eq {}} {
5451         if {[is_MacOSX]} {
5452                 set browser open
5453         } elseif {[is_Cygwin]} {
5454                 set program_files [file dirname [exec cygpath --windir]]
5455                 set program_files [file join $program_files {Program Files}]
5456                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5457                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5458                 if {[file exists $firefox]} {
5459                         set browser $firefox
5460                 } elseif {[file exists $ie]} {
5461                         set browser $ie
5462                 }
5463                 unset program_files firefox ie
5464         }
5465 }
5466
5467 if {[file isfile $doc_path]} {
5468         set doc_url "file:$doc_path"
5469 } else {
5470         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5471 }
5472
5473 if {$browser ne {}} {
5474         .mbar.help add command -label {Online Documentation} \
5475                 -command [list exec $browser $doc_url &] \
5476                 -font font_ui
5477 }
5478 unset browser doc_path doc_url
5479
5480 # -- Standard bindings
5481 #
5482 bind .   <Destroy> do_quit
5483 bind all <$M1B-Key-q> do_quit
5484 bind all <$M1B-Key-Q> do_quit
5485 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5486 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5487
5488 # -- Not a normal commit type invocation?  Do that instead!
5489 #
5490 switch -- $subcommand {
5491 --version -
5492 version {
5493         puts "git-gui version $appvers"
5494         exit
5495 }
5496 browser {
5497         if {[llength $argv] != 1} {
5498                 puts stderr "usage: $argv0 browser commit"
5499                 exit 1
5500         }
5501         set current_branch [lindex $argv 0]
5502         new_browser $current_branch
5503         return
5504 }
5505 blame {
5506         if {[llength $argv] != 2} {
5507                 puts stderr "usage: $argv0 blame commit path"
5508                 exit 1
5509         }
5510         set current_branch [lindex $argv 0]
5511         show_blame $current_branch [lindex $argv 1]
5512         return
5513 }
5514 citool -
5515 gui {
5516         if {[llength $argv] != 0} {
5517                 puts -nonewline stderr "usage: $argv0"
5518                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5519                         puts -nonewline stderr " $subcommand"
5520                 }
5521                 puts stderr {}
5522                 exit 1
5523         }
5524         # fall through to setup UI for commits
5525 }
5526 default {
5527         puts stderr "usage: $argv0 \[{blame|browser|citool}\]"
5528         exit 1
5529 }
5530 }
5531
5532 # -- Branch Control
5533 #
5534 frame .branch \
5535         -borderwidth 1 \
5536         -relief sunken
5537 label .branch.l1 \
5538         -text {Current Branch:} \
5539         -anchor w \
5540         -justify left \
5541         -font font_ui
5542 label .branch.cb \
5543         -textvariable current_branch \
5544         -anchor w \
5545         -justify left \
5546         -font font_ui
5547 pack .branch.l1 -side left
5548 pack .branch.cb -side left -fill x
5549 pack .branch -side top -fill x
5550
5551 # -- Main Window Layout
5552 #
5553 panedwindow .vpane -orient vertical
5554 panedwindow .vpane.files -orient horizontal
5555 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5556 pack .vpane -anchor n -side top -fill both -expand 1
5557
5558 # -- Index File List
5559 #
5560 frame .vpane.files.index -height 100 -width 200
5561 label .vpane.files.index.title -text {Changes To Be Committed} \
5562         -background green \
5563         -font font_ui
5564 text $ui_index -background white -borderwidth 0 \
5565         -width 20 -height 10 \
5566         -wrap none \
5567         -font font_ui \
5568         -cursor $cursor_ptr \
5569         -xscrollcommand {.vpane.files.index.sx set} \
5570         -yscrollcommand {.vpane.files.index.sy set} \
5571         -state disabled
5572 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5573 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5574 pack .vpane.files.index.title -side top -fill x
5575 pack .vpane.files.index.sx -side bottom -fill x
5576 pack .vpane.files.index.sy -side right -fill y
5577 pack $ui_index -side left -fill both -expand 1
5578 .vpane.files add .vpane.files.index -sticky nsew
5579
5580 # -- Working Directory File List
5581 #
5582 frame .vpane.files.workdir -height 100 -width 200
5583 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5584         -background red \
5585         -font font_ui
5586 text $ui_workdir -background white -borderwidth 0 \
5587         -width 20 -height 10 \
5588         -wrap none \
5589         -font font_ui \
5590         -cursor $cursor_ptr \
5591         -xscrollcommand {.vpane.files.workdir.sx set} \
5592         -yscrollcommand {.vpane.files.workdir.sy set} \
5593         -state disabled
5594 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5595 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5596 pack .vpane.files.workdir.title -side top -fill x
5597 pack .vpane.files.workdir.sx -side bottom -fill x
5598 pack .vpane.files.workdir.sy -side right -fill y
5599 pack $ui_workdir -side left -fill both -expand 1
5600 .vpane.files add .vpane.files.workdir -sticky nsew
5601
5602 foreach i [list $ui_index $ui_workdir] {
5603         $i tag conf in_diff -font font_uibold
5604         $i tag conf in_sel \
5605                 -background [$i cget -foreground] \
5606                 -foreground [$i cget -background]
5607 }
5608 unset i
5609
5610 # -- Diff and Commit Area
5611 #
5612 frame .vpane.lower -height 300 -width 400
5613 frame .vpane.lower.commarea
5614 frame .vpane.lower.diff -relief sunken -borderwidth 1
5615 pack .vpane.lower.commarea -side top -fill x
5616 pack .vpane.lower.diff -side bottom -fill both -expand 1
5617 .vpane add .vpane.lower -sticky nsew
5618
5619 # -- Commit Area Buttons
5620 #
5621 frame .vpane.lower.commarea.buttons
5622 label .vpane.lower.commarea.buttons.l -text {} \
5623         -anchor w \
5624         -justify left \
5625         -font font_ui
5626 pack .vpane.lower.commarea.buttons.l -side top -fill x
5627 pack .vpane.lower.commarea.buttons -side left -fill y
5628
5629 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5630         -command do_rescan \
5631         -font font_ui
5632 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5633 lappend disable_on_lock \
5634         {.vpane.lower.commarea.buttons.rescan conf -state}
5635
5636 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5637         -command do_add_all \
5638         -font font_ui
5639 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5640 lappend disable_on_lock \
5641         {.vpane.lower.commarea.buttons.incall conf -state}
5642
5643 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5644         -command do_signoff \
5645         -font font_ui
5646 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5647
5648 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5649         -command do_commit \
5650         -font font_ui
5651 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5652 lappend disable_on_lock \
5653         {.vpane.lower.commarea.buttons.commit conf -state}
5654
5655 # -- Commit Message Buffer
5656 #
5657 frame .vpane.lower.commarea.buffer
5658 frame .vpane.lower.commarea.buffer.header
5659 set ui_comm .vpane.lower.commarea.buffer.t
5660 set ui_coml .vpane.lower.commarea.buffer.header.l
5661 radiobutton .vpane.lower.commarea.buffer.header.new \
5662         -text {New Commit} \
5663         -command do_select_commit_type \
5664         -variable selected_commit_type \
5665         -value new \
5666         -font font_ui
5667 lappend disable_on_lock \
5668         [list .vpane.lower.commarea.buffer.header.new conf -state]
5669 radiobutton .vpane.lower.commarea.buffer.header.amend \
5670         -text {Amend Last Commit} \
5671         -command do_select_commit_type \
5672         -variable selected_commit_type \
5673         -value amend \
5674         -font font_ui
5675 lappend disable_on_lock \
5676         [list .vpane.lower.commarea.buffer.header.amend conf -state]
5677 label $ui_coml \
5678         -anchor w \
5679         -justify left \
5680         -font font_ui
5681 proc trace_commit_type {varname args} {
5682         global ui_coml commit_type
5683         switch -glob -- $commit_type {
5684         initial       {set txt {Initial Commit Message:}}
5685         amend         {set txt {Amended Commit Message:}}
5686         amend-initial {set txt {Amended Initial Commit Message:}}
5687         amend-merge   {set txt {Amended Merge Commit Message:}}
5688         merge         {set txt {Merge Commit Message:}}
5689         *             {set txt {Commit Message:}}
5690         }
5691         $ui_coml conf -text $txt
5692 }
5693 trace add variable commit_type write trace_commit_type
5694 pack $ui_coml -side left -fill x
5695 pack .vpane.lower.commarea.buffer.header.amend -side right
5696 pack .vpane.lower.commarea.buffer.header.new -side right
5697
5698 text $ui_comm -background white -borderwidth 1 \
5699         -undo true \
5700         -maxundo 20 \
5701         -autoseparators true \
5702         -relief sunken \
5703         -width 75 -height 9 -wrap none \
5704         -font font_diff \
5705         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5706 scrollbar .vpane.lower.commarea.buffer.sby \
5707         -command [list $ui_comm yview]
5708 pack .vpane.lower.commarea.buffer.header -side top -fill x
5709 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5710 pack $ui_comm -side left -fill y
5711 pack .vpane.lower.commarea.buffer -side left -fill y
5712
5713 # -- Commit Message Buffer Context Menu
5714 #
5715 set ctxm .vpane.lower.commarea.buffer.ctxm
5716 menu $ctxm -tearoff 0
5717 $ctxm add command \
5718         -label {Cut} \
5719         -font font_ui \
5720         -command {tk_textCut $ui_comm}
5721 $ctxm add command \
5722         -label {Copy} \
5723         -font font_ui \
5724         -command {tk_textCopy $ui_comm}
5725 $ctxm add command \
5726         -label {Paste} \
5727         -font font_ui \
5728         -command {tk_textPaste $ui_comm}
5729 $ctxm add command \
5730         -label {Delete} \
5731         -font font_ui \
5732         -command {$ui_comm delete sel.first sel.last}
5733 $ctxm add separator
5734 $ctxm add command \
5735         -label {Select All} \
5736         -font font_ui \
5737         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5738 $ctxm add command \
5739         -label {Copy All} \
5740         -font font_ui \
5741         -command {
5742                 $ui_comm tag add sel 0.0 end
5743                 tk_textCopy $ui_comm
5744                 $ui_comm tag remove sel 0.0 end
5745         }
5746 $ctxm add separator
5747 $ctxm add command \
5748         -label {Sign Off} \
5749         -font font_ui \
5750         -command do_signoff
5751 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5752
5753 # -- Diff Header
5754 #
5755 proc trace_current_diff_path {varname args} {
5756         global current_diff_path diff_actions file_states
5757         if {$current_diff_path eq {}} {
5758                 set s {}
5759                 set f {}
5760                 set p {}
5761                 set o disabled
5762         } else {
5763                 set p $current_diff_path
5764                 set s [mapdesc [lindex $file_states($p) 0] $p]
5765                 set f {File:}
5766                 set p [escape_path $p]
5767                 set o normal
5768         }
5769
5770         .vpane.lower.diff.header.status configure -text $s
5771         .vpane.lower.diff.header.file configure -text $f
5772         .vpane.lower.diff.header.path configure -text $p
5773         foreach w $diff_actions {
5774                 uplevel #0 $w $o
5775         }
5776 }
5777 trace add variable current_diff_path write trace_current_diff_path
5778
5779 frame .vpane.lower.diff.header -background orange
5780 label .vpane.lower.diff.header.status \
5781         -background orange \
5782         -width $max_status_desc \
5783         -anchor w \
5784         -justify left \
5785         -font font_ui
5786 label .vpane.lower.diff.header.file \
5787         -background orange \
5788         -anchor w \
5789         -justify left \
5790         -font font_ui
5791 label .vpane.lower.diff.header.path \
5792         -background orange \
5793         -anchor w \
5794         -justify left \
5795         -font font_ui
5796 pack .vpane.lower.diff.header.status -side left
5797 pack .vpane.lower.diff.header.file -side left
5798 pack .vpane.lower.diff.header.path -fill x
5799 set ctxm .vpane.lower.diff.header.ctxm
5800 menu $ctxm -tearoff 0
5801 $ctxm add command \
5802         -label {Copy} \
5803         -font font_ui \
5804         -command {
5805                 clipboard clear
5806                 clipboard append \
5807                         -format STRING \
5808                         -type STRING \
5809                         -- $current_diff_path
5810         }
5811 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5812 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5813
5814 # -- Diff Body
5815 #
5816 frame .vpane.lower.diff.body
5817 set ui_diff .vpane.lower.diff.body.t
5818 text $ui_diff -background white -borderwidth 0 \
5819         -width 80 -height 15 -wrap none \
5820         -font font_diff \
5821         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5822         -yscrollcommand {.vpane.lower.diff.body.sby set} \
5823         -state disabled
5824 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5825         -command [list $ui_diff xview]
5826 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5827         -command [list $ui_diff yview]
5828 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5829 pack .vpane.lower.diff.body.sby -side right -fill y
5830 pack $ui_diff -side left -fill both -expand 1
5831 pack .vpane.lower.diff.header -side top -fill x
5832 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5833
5834 $ui_diff tag conf d_cr -elide true
5835 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5836 $ui_diff tag conf d_+ -foreground {#00a000}
5837 $ui_diff tag conf d_- -foreground red
5838
5839 $ui_diff tag conf d_++ -foreground {#00a000}
5840 $ui_diff tag conf d_-- -foreground red
5841 $ui_diff tag conf d_+s \
5842         -foreground {#00a000} \
5843         -background {#e2effa}
5844 $ui_diff tag conf d_-s \
5845         -foreground red \
5846         -background {#e2effa}
5847 $ui_diff tag conf d_s+ \
5848         -foreground {#00a000} \
5849         -background ivory1
5850 $ui_diff tag conf d_s- \
5851         -foreground red \
5852         -background ivory1
5853
5854 $ui_diff tag conf d<<<<<<< \
5855         -foreground orange \
5856         -font font_diffbold
5857 $ui_diff tag conf d======= \
5858         -foreground orange \
5859         -font font_diffbold
5860 $ui_diff tag conf d>>>>>>> \
5861         -foreground orange \
5862         -font font_diffbold
5863
5864 $ui_diff tag raise sel
5865
5866 # -- Diff Body Context Menu
5867 #
5868 set ctxm .vpane.lower.diff.body.ctxm
5869 menu $ctxm -tearoff 0
5870 $ctxm add command \
5871         -label {Refresh} \
5872         -font font_ui \
5873         -command reshow_diff
5874 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5875 $ctxm add command \
5876         -label {Copy} \
5877         -font font_ui \
5878         -command {tk_textCopy $ui_diff}
5879 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5880 $ctxm add command \
5881         -label {Select All} \
5882         -font font_ui \
5883         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5884 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5885 $ctxm add command \
5886         -label {Copy All} \
5887         -font font_ui \
5888         -command {
5889                 $ui_diff tag add sel 0.0 end
5890                 tk_textCopy $ui_diff
5891                 $ui_diff tag remove sel 0.0 end
5892         }
5893 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5894 $ctxm add separator
5895 $ctxm add command \
5896         -label {Apply/Reverse Hunk} \
5897         -font font_ui \
5898         -command {apply_hunk $cursorX $cursorY}
5899 set ui_diff_applyhunk [$ctxm index last]
5900 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5901 $ctxm add separator
5902 $ctxm add command \
5903         -label {Decrease Font Size} \
5904         -font font_ui \
5905         -command {incr_font_size font_diff -1}
5906 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5907 $ctxm add command \
5908         -label {Increase Font Size} \
5909         -font font_ui \
5910         -command {incr_font_size font_diff 1}
5911 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5912 $ctxm add separator
5913 $ctxm add command \
5914         -label {Show Less Context} \
5915         -font font_ui \
5916         -command {if {$repo_config(gui.diffcontext) >= 2} {
5917                 incr repo_config(gui.diffcontext) -1
5918                 reshow_diff
5919         }}
5920 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5921 $ctxm add command \
5922         -label {Show More Context} \
5923         -font font_ui \
5924         -command {
5925                 incr repo_config(gui.diffcontext)
5926                 reshow_diff
5927         }
5928 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5929 $ctxm add separator
5930 $ctxm add command -label {Options...} \
5931         -font font_ui \
5932         -command do_options
5933 bind_button3 $ui_diff "
5934         set cursorX %x
5935         set cursorY %y
5936         if {\$ui_index eq \$current_diff_side} {
5937                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5938         } else {
5939                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5940         }
5941         tk_popup $ctxm %X %Y
5942 "
5943 unset ui_diff_applyhunk
5944
5945 # -- Status Bar
5946 #
5947 label .status -textvariable ui_status_value \
5948         -anchor w \
5949         -justify left \
5950         -borderwidth 1 \
5951         -relief sunken \
5952         -font font_ui
5953 pack .status -anchor w -side bottom -fill x
5954
5955 # -- Load geometry
5956 #
5957 catch {
5958 set gm $repo_config(gui.geometry)
5959 wm geometry . [lindex $gm 0]
5960 .vpane sash place 0 \
5961         [lindex [.vpane sash coord 0] 0] \
5962         [lindex $gm 1]
5963 .vpane.files sash place 0 \
5964         [lindex $gm 2] \
5965         [lindex [.vpane.files sash coord 0] 1]
5966 unset gm
5967 }
5968
5969 # -- Key Bindings
5970 #
5971 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5972 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5973 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5974 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5975 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5976 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5977 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5978 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5979 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5980 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5981 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5982
5983 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5984 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5985 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5986 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5987 bind $ui_diff <$M1B-Key-v> {break}
5988 bind $ui_diff <$M1B-Key-V> {break}
5989 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5990 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5991 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5992 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5993 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5994 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5995 bind $ui_diff <Button-1>   {focus %W}
5996
5997 if {[is_enabled branch]} {
5998         bind . <$M1B-Key-n> do_create_branch
5999         bind . <$M1B-Key-N> do_create_branch
6000 }
6001
6002 bind all <Key-F5> do_rescan
6003 bind all <$M1B-Key-r> do_rescan
6004 bind all <$M1B-Key-R> do_rescan
6005 bind .   <$M1B-Key-s> do_signoff
6006 bind .   <$M1B-Key-S> do_signoff
6007 bind .   <$M1B-Key-i> do_add_all
6008 bind .   <$M1B-Key-I> do_add_all
6009 bind .   <$M1B-Key-Return> do_commit
6010 foreach i [list $ui_index $ui_workdir] {
6011         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
6012         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
6013         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
6014 }
6015 unset i
6016
6017 set file_lists($ui_index) [list]
6018 set file_lists($ui_workdir) [list]
6019
6020 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
6021 focus -force $ui_comm
6022
6023 # -- Warn the user about environmental problems.  Cygwin's Tcl
6024 #    does *not* pass its env array onto any processes it spawns.
6025 #    This means that git processes get none of our environment.
6026 #
6027 if {[is_Cygwin]} {
6028         set ignored_env 0
6029         set suggest_user {}
6030         set msg "Possible environment issues exist.
6031
6032 The following environment variables are probably
6033 going to be ignored by any Git subprocess run
6034 by [appname]:
6035
6036 "
6037         foreach name [array names env] {
6038                 switch -regexp -- $name {
6039                 {^GIT_INDEX_FILE$} -
6040                 {^GIT_OBJECT_DIRECTORY$} -
6041                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
6042                 {^GIT_DIFF_OPTS$} -
6043                 {^GIT_EXTERNAL_DIFF$} -
6044                 {^GIT_PAGER$} -
6045                 {^GIT_TRACE$} -
6046                 {^GIT_CONFIG$} -
6047                 {^GIT_CONFIG_LOCAL$} -
6048                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
6049                         append msg " - $name\n"
6050                         incr ignored_env
6051                 }
6052                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
6053                         append msg " - $name\n"
6054                         incr ignored_env
6055                         set suggest_user $name
6056                 }
6057                 }
6058         }
6059         if {$ignored_env > 0} {
6060                 append msg "
6061 This is due to a known issue with the
6062 Tcl binary distributed by Cygwin."
6063
6064                 if {$suggest_user ne {}} {
6065                         append msg "
6066
6067 A good replacement for $suggest_user
6068 is placing values for the user.name and
6069 user.email settings into your personal
6070 ~/.gitconfig file.
6071 "
6072                 }
6073                 warn_popup $msg
6074         }
6075         unset ignored_env msg suggest_user name
6076 }
6077
6078 # -- Only initialize complex UI if we are going to stay running.
6079 #
6080 if {[is_enabled transport]} {
6081         load_all_remotes
6082         load_all_heads
6083
6084         populate_branch_menu
6085         populate_fetch_menu
6086         populate_push_menu
6087 }
6088
6089 # -- Only suggest a gc run if we are going to stay running.
6090 #
6091 if {[is_enabled multicommit]} {
6092         set object_limit 2000
6093         if {[is_Windows]} {set object_limit 200}
6094         regexp {^([0-9]+) objects,} [git count-objects] _junk objects_current
6095         if {$objects_current >= $object_limit} {
6096                 if {[ask_popup \
6097                         "This repository currently has $objects_current loose objects.
6098
6099 To maintain optimal performance it is strongly
6100 recommended that you compress the database
6101 when more than $object_limit loose objects exist.
6102
6103 Compress the database now?"] eq yes} {
6104                         do_gc
6105                 }
6106         }
6107         unset object_limit _junk objects_current
6108 }
6109
6110 lock_index begin-read
6111 after 1 do_rescan