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