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