git-gui.sh

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 set appvers {@@GIT_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 [exec 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 {exec git config --global --unset $name}
 206                         } else {
 207                                 regsub -all "\[{}\]" $value {"} value
 208                                 exec git config --global $name $value
 209                         }
 210                         set global_config($name) $value
 211                         if {$value eq $repo_config($name)} {
 212                                 catch {exec 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 {exec git config --unset $name}
 223                         } else {
 224                                 regsub -all "\[{}\]" $value {"} value
 225                                 exec git config $name $value
 226                         }
 227                         set repo_config($name) $value
 228                 }
 229         }
 230 }
 231
 232 proc error_popup {msg} {
 233         set title [appname]
 234         if {[reponame] ne {}} {
 235                 append title " ([reponame])"
 236         }
 237         set cmd [list tk_messageBox \
 238                 -icon error \
 239                 -type ok \
 240                 -title "$title: error" \
 241                 -message $msg]
 242         if {[winfo ismapped .]} {
 243                 lappend cmd -parent .
 244         }
 245         eval $cmd
 246 }
 247
 248 proc warn_popup {msg} {
 249         set title [appname]
 250         if {[reponame] ne {}} {
 251                 append title " ([reponame])"
 252         }
 253         set cmd [list tk_messageBox \
 254                 -icon warning \
 255                 -type ok \
 256                 -title "$title: warning" \
 257                 -message $msg]
 258         if {[winfo ismapped .]} {
 259                 lappend cmd -parent .
 260         }
 261         eval $cmd
 262 }
 263
 264 proc info_popup {msg {parent .}} {
 265         set title [appname]
 266         if {[reponame] ne {}} {
 267                 append title " ([reponame])"
 268         }
 269         tk_messageBox \
 270                 -parent $parent \
 271                 -icon info \
 272                 -type ok \
 273                 -title $title \
 274                 -message $msg
 275 }
 276
 277 proc ask_popup {msg} {
 278         set title [appname]
 279         if {[reponame] ne {}} {
 280                 append title " ([reponame])"
 281         }
 282         return [tk_messageBox \
 283                 -parent . \
 284                 -icon question \
 285                 -type yesno \
 286                 -title $title \
 287                 -message $msg]
 288 }
 289
 290 ######################################################################
 291 ##
 292 ## repository setup
 293
 294 if {   [catch {set _gitdir $env(GIT_DIR)}]
 295         && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 296         catch {wm withdraw .}
 297         error_popup "Cannot find the git directory:\n\n$err"
 298         exit 1
 299 }
 300 if {![file isdirectory $_gitdir] && [is_Cygwin]} {
 301         catch {set _gitdir [exec cygpath --unix $_gitdir]}
 302 }
 303 if {![file isdirectory $_gitdir]} {
 304         catch {wm withdraw .}
 305         error_popup "Git directory not found:\n\n$_gitdir"
 306         exit 1
 307 }
 308 if {[lindex [file split $_gitdir] end] ne {.git}} {
 309         catch {wm withdraw .}
 310         error_popup "Cannot use funny .git directory:\n\n$_gitdir"
 311         exit 1
 312 }
 313 if {[catch {cd [file dirname $_gitdir]} err]} {
 314         catch {wm withdraw .}
 315         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 316         exit 1
 317 }
 318 set _reponame [lindex [file split \
 319         [file normalize [file dirname $_gitdir]]] \
 320         end]
 321
 322 ######################################################################
 323 ##
 324 ## task management
 325
 326 set rescan_active 0
 327 set diff_active 0
 328 set last_clicked {}
 329
 330 set disable_on_lock [list]
 331 set index_lock_type none
 332
 333 proc lock_index {type} {
 334         global index_lock_type disable_on_lock
 335
 336         if {$index_lock_type eq {none}} {
 337                 set index_lock_type $type
 338                 foreach w $disable_on_lock {
 339                         uplevel #0 $w disabled
 340                 }
 341                 return 1
 342         } elseif {$index_lock_type eq "begin-$type"} {
 343                 set index_lock_type $type
 344                 return 1
 345         }
 346         return 0
 347 }
 348
 349 proc unlock_index {} {
 350         global index_lock_type disable_on_lock
 351
 352         set index_lock_type none
 353         foreach w $disable_on_lock {
 354                 uplevel #0 $w normal
 355         }
 356 }
 357
 358 ######################################################################
 359 ##
 360 ## status
 361
 362 proc repository_state {ctvar hdvar mhvar} {
 363         global current_branch
 364         upvar $ctvar ct $hdvar hd $mhvar mh
 365
 366         set mh [list]
 367
 368         if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 369                 set current_branch {}
 370         } else {
 371                 regsub ^refs/((heads|tags|remotes)/)? \
 372                         $current_branch \
 373                         {} \
 374                         current_branch
 375         }
 376
 377         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 378                 set hd {}
 379                 set ct initial
 380                 return
 381         }
 382
 383         set merge_head [gitdir MERGE_HEAD]
 384         if {[file exists $merge_head]} {
 385                 set ct merge
 386                 set fd_mh [open $merge_head r]
 387                 while {[gets $fd_mh line] >= 0} {
 388                         lappend mh $line
 389                 }
 390                 close $fd_mh
 391                 return
 392         }
 393
 394         set ct normal
 395 }
 396
 397 proc PARENT {} {
 398         global PARENT empty_tree
 399
 400         set p [lindex $PARENT 0]
 401         if {$p ne {}} {
 402                 return $p
 403         }
 404         if {$empty_tree eq {}} {
 405                 set empty_tree [exec git mktree << {}]
 406         }
 407         return $empty_tree
 408 }
 409
 410 proc rescan {after {honor_trustmtime 1}} {
 411         global HEAD PARENT MERGE_HEAD commit_type
 412         global ui_index ui_workdir ui_status_value ui_comm
 413         global rescan_active file_states
 414         global repo_config
 415
 416         if {$rescan_active > 0 || ![lock_index read]} return
 417
 418         repository_state newType newHEAD newMERGE_HEAD
 419         if {[string match amend* $commit_type]
 420                 && $newType eq {normal}
 421                 && $newHEAD eq $HEAD} {
 422         } else {
 423                 set HEAD $newHEAD
 424                 set PARENT $newHEAD
 425                 set MERGE_HEAD $newMERGE_HEAD
 426                 set commit_type $newType
 427         }
 428
 429         array unset file_states
 430
 431         if {![$ui_comm edit modified]
 432                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 433                 if {[load_message GITGUI_MSG]} {
 434                 } elseif {[load_message MERGE_MSG]} {
 435                 } elseif {[load_message SQUASH_MSG]} {
 436                 }
 437                 $ui_comm edit reset
 438                 $ui_comm edit modified false
 439         }
 440
 441         if {[is_enabled branch]} {
 442                 load_all_heads
 443                 populate_branch_menu
 444         }
 445
 446         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 447                 rescan_stage2 {} $after
 448         } else {
 449                 set rescan_active 1
 450                 set ui_status_value {Refreshing file status...}
 451                 set cmd [list git update-index]
 452                 lappend cmd -q
 453                 lappend cmd --unmerged
 454                 lappend cmd --ignore-missing
 455                 lappend cmd --refresh
 456                 set fd_rf [open "| $cmd" r]
 457                 fconfigure $fd_rf -blocking 0 -translation binary
 458                 fileevent $fd_rf readable \
 459                         [list rescan_stage2 $fd_rf $after]
 460         }
 461 }
 462
 463 proc rescan_stage2 {fd after} {
 464         global ui_status_value
 465         global rescan_active buf_rdi buf_rdf buf_rlo
 466
 467         if {$fd ne {}} {
 468                 read $fd
 469                 if {![eof $fd]} return
 470                 close $fd
 471         }
 472
 473         set ls_others [list | git ls-files --others -z \
 474                 --exclude-per-directory=.gitignore]
 475         set info_exclude [gitdir info exclude]
 476         if {[file readable $info_exclude]} {
 477                 lappend ls_others "--exclude-from=$info_exclude"
 478         }
 479
 480         set buf_rdi {}
 481         set buf_rdf {}
 482         set buf_rlo {}
 483
 484         set rescan_active 3
 485         set ui_status_value {Scanning for modified files ...}
 486         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 487         set fd_df [open "| git diff-files -z" r]
 488         set fd_lo [open $ls_others r]
 489
 490         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 491         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 492         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 493         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 494         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 495         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 496 }
 497
 498 proc load_message {file} {
 499         global ui_comm
 500
 501         set f [gitdir $file]
 502         if {[file isfile $f]} {
 503                 if {[catch {set fd [open $f r]}]} {
 504                         return 0
 505                 }
 506                 set content [string trim [read $fd]]
 507                 close $fd
 508                 regsub -all -line {[ \r\t]+$} $content {} content
 509                 $ui_comm delete 0.0 end
 510                 $ui_comm insert end $content
 511                 return 1
 512         }
 513         return 0
 514 }
 515
 516 proc read_diff_index {fd after} {
 517         global buf_rdi
 518
 519         append buf_rdi [read $fd]
 520         set c 0
 521         set n [string length $buf_rdi]
 522         while {$c < $n} {
 523                 set z1 [string first "\0" $buf_rdi $c]
 524                 if {$z1 == -1} break
 525                 incr z1
 526                 set z2 [string first "\0" $buf_rdi $z1]
 527                 if {$z2 == -1} break
 528
 529                 incr c
 530                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 531                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 532                 merge_state \
 533                         [encoding convertfrom $p] \
 534                         [lindex $i 4]? \
 535                         [list [lindex $i 0] [lindex $i 2]] \
 536                         [list]
 537                 set c $z2
 538                 incr c
 539         }
 540         if {$c < $n} {
 541                 set buf_rdi [string range $buf_rdi $c end]
 542         } else {
 543                 set buf_rdi {}
 544         }
 545
 546         rescan_done $fd buf_rdi $after
 547 }
 548
 549 proc read_diff_files {fd after} {
 550         global buf_rdf
 551
 552         append buf_rdf [read $fd]
 553         set c 0
 554         set n [string length $buf_rdf]
 555         while {$c < $n} {
 556                 set z1 [string first "\0" $buf_rdf $c]
 557                 if {$z1 == -1} break
 558                 incr z1
 559                 set z2 [string first "\0" $buf_rdf $z1]
 560                 if {$z2 == -1} break
 561
 562                 incr c
 563                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 564                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 565                 merge_state \
 566                         [encoding convertfrom $p] \
 567                         ?[lindex $i 4] \
 568                         [list] \
 569                         [list [lindex $i 0] [lindex $i 2]]
 570                 set c $z2
 571                 incr c
 572         }
 573         if {$c < $n} {
 574                 set buf_rdf [string range $buf_rdf $c end]
 575         } else {
 576                 set buf_rdf {}
 577         }
 578
 579         rescan_done $fd buf_rdf $after
 580 }
 581
 582 proc read_ls_others {fd after} {
 583         global buf_rlo
 584
 585         append buf_rlo [read $fd]
 586         set pck [split $buf_rlo "\0"]
 587         set buf_rlo [lindex $pck end]
 588         foreach p [lrange $pck 0 end-1] {
 589                 merge_state [encoding convertfrom $p] ?O
 590         }
 591         rescan_done $fd buf_rlo $after
 592 }
 593
 594 proc rescan_done {fd buf after} {
 595         global rescan_active
 596         global file_states repo_config
 597         upvar $buf to_clear
 598
 599         if {![eof $fd]} return
 600         set to_clear {}
 601         close $fd
 602         if {[incr rescan_active -1] > 0} return
 603
 604         prune_selection
 605         unlock_index
 606         display_all_files
 607         reshow_diff
 608         uplevel #0 $after
 609 }
 610
 611 proc prune_selection {} {
 612         global file_states selected_paths
 613
 614         foreach path [array names selected_paths] {
 615                 if {[catch {set still_here $file_states($path)}]} {
 616                         unset selected_paths($path)
 617                 }
 618         }
 619 }
 620
 621 ######################################################################
 622 ##
 623 ## diff
 624
 625 proc clear_diff {} {
 626         global ui_diff current_diff_path current_diff_header
 627         global ui_index ui_workdir
 628
 629         $ui_diff conf -state normal
 630         $ui_diff delete 0.0 end
 631         $ui_diff conf -state disabled
 632
 633         set current_diff_path {}
 634         set current_diff_header {}
 635
 636         $ui_index tag remove in_diff 0.0 end
 637         $ui_workdir tag remove in_diff 0.0 end
 638 }
 639
 640 proc reshow_diff {} {
 641         global ui_status_value file_states file_lists
 642         global current_diff_path current_diff_side
 643
 644         set p $current_diff_path
 645         if {$p eq {}
 646                 || $current_diff_side eq {}
 647                 || [catch {set s $file_states($p)}]
 648                 || [lsearch -sorted -exact $file_lists($current_diff_side) $p] == -1} {
 649                 clear_diff
 650         } else {
 651                 show_diff $p $current_diff_side
 652         }
 653 }
 654
 655 proc handle_empty_diff {} {
 656         global current_diff_path file_states file_lists
 657
 658         set path $current_diff_path
 659         set s $file_states($path)
 660         if {[lindex $s 0] ne {_M}} return
 661
 662         info_popup "No differences detected.
 663
 664 [short_path $path] has no changes.
 665
 666 The modification date of this file was updated
 667 by another application, but the content within
 668 the file was not changed.
 669
 670 A rescan will be automatically started to find
 671 other files which may have the same state."
 672
 673         clear_diff
 674         display_file $path __
 675         rescan {set ui_status_value {Ready.}} 0
 676 }
 677
 678 proc show_diff {path w {lno {}}} {
 679         global file_states file_lists
 680         global is_3way_diff diff_active repo_config
 681         global ui_diff ui_status_value ui_index ui_workdir
 682         global current_diff_path current_diff_side current_diff_header
 683
 684         if {$diff_active || ![lock_index read]} return
 685
 686         clear_diff
 687         if {$lno == {}} {
 688                 set lno [lsearch -sorted -exact $file_lists($w) $path]
 689                 if {$lno >= 0} {
 690                         incr lno
 691                 }
 692         }
 693         if {$lno >= 1} {
 694                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 695         }
 696
 697         set s $file_states($path)
 698         set m [lindex $s 0]
 699         set is_3way_diff 0
 700         set diff_active 1
 701         set current_diff_path $path
 702         set current_diff_side $w
 703         set current_diff_header {}
 704         set ui_status_value "Loading diff of [escape_path $path]..."
 705
 706         # - Git won't give us the diff, there's nothing to compare to!
 707         #
 708         if {$m eq {_O}} {
 709                 set max_sz [expr {128 * 1024}]
 710                 if {[catch {
 711                                 set fd [open $path r]
 712                                 set content [read $fd $max_sz]
 713                                 close $fd
 714                                 set sz [file size $path]
 715                         } err ]} {
 716                         set diff_active 0
 717                         unlock_index
 718                         set ui_status_value "Unable to display [escape_path $path]"
 719                         error_popup "Error loading file:\n\n$err"
 720                         return
 721                 }
 722                 $ui_diff conf -state normal
 723                 if {![catch {set type [exec file $path]}]} {
 724                         set n [string length $path]
 725                         if {[string equal -length $n $path $type]} {
 726                                 set type [string range $type $n end]
 727                                 regsub {^:?\s*} $type {} type
 728                         }
 729                         $ui_diff insert end "* $type\n" d_@
 730                 }
 731                 if {[string first "\0" $content] != -1} {
 732                         $ui_diff insert end \
 733                                 "* Binary file (not showing content)." \
 734                                 d_@
 735                 } else {
 736                         if {$sz > $max_sz} {
 737                                 $ui_diff insert end \
 738 "* Untracked file is $sz bytes.
 739 * Showing only first $max_sz bytes.
 740 " d_@
 741                         }
 742                         $ui_diff insert end $content
 743                         if {$sz > $max_sz} {
 744                                 $ui_diff insert end "
 745 * Untracked file clipped here by [appname].
 746 * To see the entire file, use an external editor.
 747 " d_@
 748                         }
 749                 }
 750                 $ui_diff conf -state disabled
 751                 set diff_active 0
 752                 unlock_index
 753                 set ui_status_value {Ready.}
 754                 return
 755         }
 756
 757         set cmd [list | git]
 758         if {$w eq $ui_index} {
 759                 lappend cmd diff-index
 760                 lappend cmd --cached
 761         } elseif {$w eq $ui_workdir} {
 762                 if {[string index $m 0] eq {U}} {
 763                         lappend cmd diff
 764                 } else {
 765                         lappend cmd diff-files
 766                 }
 767         }
 768
 769         lappend cmd -p
 770         lappend cmd --no-color
 771         if {$repo_config(gui.diffcontext) > 0} {
 772                 lappend cmd "-U$repo_config(gui.diffcontext)"
 773         }
 774         if {$w eq $ui_index} {
 775                 lappend cmd [PARENT]
 776         }
 777         lappend cmd --
 778         lappend cmd $path
 779
 780         if {[catch {set fd [open $cmd r]} err]} {
 781                 set diff_active 0
 782                 unlock_index
 783                 set ui_status_value "Unable to display [escape_path $path]"
 784                 error_popup "Error loading diff:\n\n$err"
 785                 return
 786         }
 787
 788         fconfigure $fd \
 789                 -blocking 0 \
 790                 -encoding binary \
 791                 -translation binary
 792         fileevent $fd readable [list read_diff $fd]
 793 }
 794
 795 proc read_diff {fd} {
 796         global ui_diff ui_status_value diff_active
 797         global is_3way_diff current_diff_header
 798
 799         $ui_diff conf -state normal
 800         while {[gets $fd line] >= 0} {
 801                 # -- Cleanup uninteresting diff header lines.
 802                 #
 803                 if {   [string match {diff --git *}      $line]
 804                         || [string match {diff --cc *}       $line]
 805                         || [string match {diff --combined *} $line]
 806                         || [string match {--- *}             $line]
 807                         || [string match {+++ *}             $line]} {
 808                         append current_diff_header $line "\n"
 809                         continue
 810                 }
 811                 if {[string match {index *} $line]} continue
 812                 if {$line eq {deleted file mode 120000}} {
 813                         set line "deleted symlink"
 814                 }
 815
 816                 # -- Automatically detect if this is a 3 way diff.
 817                 #
 818                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 819
 820                 if {[string match {mode *} $line]
 821                         || [string match {new file *} $line]
 822                         || [string match {deleted file *} $line]
 823                         || [string match {Binary files * and * differ} $line]
 824                         || $line eq {\ No newline at end of file}
 825                         || [regexp {^\* Unmerged path } $line]} {
 826                         set tags {}
 827                 } elseif {$is_3way_diff} {
 828                         set op [string range $line 0 1]
 829                         switch -- $op {
 830                         {  } {set tags {}}
 831                         {@@} {set tags d_@}
 832                         { +} {set tags d_s+}
 833                         { -} {set tags d_s-}
 834                         {+ } {set tags d_+s}
 835                         {- } {set tags d_-s}
 836                         {--} {set tags d_--}
 837                         {++} {
 838                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 839                                         set line [string replace $line 0 1 {  }]
 840                                         set tags d$op
 841                                 } else {
 842                                         set tags d_++
 843                                 }
 844                         }
 845                         default {
 846                                 puts "error: Unhandled 3 way diff marker: {$op}"
 847                                 set tags {}
 848                         }
 849                         }
 850                 } else {
 851                         set op [string index $line 0]
 852                         switch -- $op {
 853                         { } {set tags {}}
 854                         {@} {set tags d_@}
 855                         {-} {set tags d_-}
 856                         {+} {
 857                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 858                                         set line [string replace $line 0 0 { }]
 859                                         set tags d$op
 860                                 } else {
 861                                         set tags d_+
 862                                 }
 863                         }
 864                         default {
 865                                 puts "error: Unhandled 2 way diff marker: {$op}"
 866                                 set tags {}
 867                         }
 868                         }
 869                 }
 870                 $ui_diff insert end $line $tags
 871                 if {[string index $line end] eq "\r"} {
 872                         $ui_diff tag add d_cr {end - 2c}
 873                 }
 874                 $ui_diff insert end "\n" $tags
 875         }
 876         $ui_diff conf -state disabled
 877
 878         if {[eof $fd]} {
 879                 close $fd
 880                 set diff_active 0
 881                 unlock_index
 882                 set ui_status_value {Ready.}
 883
 884                 if {[$ui_diff index end] eq {2.0}} {
 885                         handle_empty_diff
 886                 }
 887         }
 888 }
 889
 890 proc apply_hunk {x y} {
 891         global current_diff_path current_diff_header current_diff_side
 892         global ui_diff ui_index file_states
 893
 894         if {$current_diff_path eq {} || $current_diff_header eq {}} return
 895         if {![lock_index apply_hunk]} return
 896
 897         set apply_cmd {git apply --cached --whitespace=nowarn}
 898         set mi [lindex $file_states($current_diff_path) 0]
 899         if {$current_diff_side eq $ui_index} {
 900                 set mode unstage
 901                 lappend apply_cmd --reverse
 902                 if {[string index $mi 0] ne {M}} {
 903                         unlock_index
 904                         return
 905                 }
 906         } else {
 907                 set mode stage
 908                 if {[string index $mi 1] ne {M}} {
 909                         unlock_index
 910                         return
 911                 }
 912         }
 913
 914         set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 915         set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 916         if {$s_lno eq {}} {
 917                 unlock_index
 918                 return
 919         }
 920
 921         set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 922         if {$e_lno eq {}} {
 923                 set e_lno end
 924         }
 925
 926         if {[catch {
 927                 set p [open "| $apply_cmd" w]
 928                 fconfigure $p -translation binary -encoding binary
 929                 puts -nonewline $p $current_diff_header
 930                 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 931                 close $p} err]} {
 932                 error_popup "Failed to $mode selected hunk.\n\n$err"
 933                 unlock_index
 934                 return
 935         }
 936
 937         $ui_diff conf -state normal
 938         $ui_diff delete $s_lno $e_lno
 939         $ui_diff conf -state disabled
 940
 941         if {[$ui_diff get 1.0 end] eq "\n"} {
 942                 set o _
 943         } else {
 944                 set o ?
 945         }
 946
 947         if {$current_diff_side eq $ui_index} {
 948                 set mi ${o}M
 949         } elseif {[string index $mi 0] eq {_}} {
 950                 set mi M$o
 951         } else {
 952                 set mi ?$o
 953         }
 954         unlock_index
 955         display_file $current_diff_path $mi
 956         if {$o eq {_}} {
 957                 clear_diff
 958         }
 959 }
 960
 961 ######################################################################
 962 ##
 963 ## commit
 964
 965 proc load_last_commit {} {
 966         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 967         global repo_config
 968
 969         if {[llength $PARENT] == 0} {
 970                 error_popup {There is nothing to amend.
 971
 972 You are about to create the initial commit.
 973 There is no commit before this to amend.
 974 }
 975                 return
 976         }
 977
 978         repository_state curType curHEAD curMERGE_HEAD
 979         if {$curType eq {merge}} {
 980                 error_popup {Cannot amend while merging.
 981
 982 You are currently in the middle of a merge that
 983 has not been fully completed.  You cannot amend
 984 the prior commit unless you first abort the
 985 current merge activity.
 986 }
 987                 return
 988         }
 989
 990         set msg {}
 991         set parents [list]
 992         if {[catch {
 993                         set fd [open "| git cat-file commit $curHEAD" r]
 994                         fconfigure $fd -encoding binary -translation lf
 995                         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 996                                 set enc utf-8
 997                         }
 998                         while {[gets $fd line] > 0} {
 999                                 if {[string match {parent *} $line]} {
1000                                         lappend parents [string range $line 7 end]
1001                                 } elseif {[string match {encoding *} $line]} {
1002                                         set enc [string tolower [string range $line 9 end]]
1003                                 }
1004                         }
1005                         fconfigure $fd -encoding $enc
1006                         set msg [string trim [read $fd]]
1007                         close $fd
1008                 } err]} {
1009                 error_popup "Error loading commit data for amend:\n\n$err"
1010                 return
1011         }
1012
1013         set HEAD $curHEAD
1014         set PARENT $parents
1015         set MERGE_HEAD [list]
1016         switch -- [llength $parents] {
1017         0       {set commit_type amend-initial}
1018         1       {set commit_type amend}
1019         default {set commit_type amend-merge}
1020         }
1021
1022         $ui_comm delete 0.0 end
1023         $ui_comm insert end $msg
1024         $ui_comm edit reset
1025         $ui_comm edit modified false
1026         rescan {set ui_status_value {Ready.}}
1027 }
1028
1029 proc create_new_commit {} {
1030         global commit_type ui_comm
1031
1032         set commit_type normal
1033         $ui_comm delete 0.0 end
1034         $ui_comm edit reset
1035         $ui_comm edit modified false
1036         rescan {set ui_status_value {Ready.}}
1037 }
1038
1039 set GIT_COMMITTER_IDENT {}
1040
1041 proc committer_ident {} {
1042         global GIT_COMMITTER_IDENT
1043
1044         if {$GIT_COMMITTER_IDENT eq {}} {
1045                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1046                         error_popup "Unable to obtain your identity:\n\n$err"
1047                         return {}
1048                 }
1049                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1050                         $me me GIT_COMMITTER_IDENT]} {
1051                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1052                         return {}
1053                 }
1054         }
1055
1056         return $GIT_COMMITTER_IDENT
1057 }
1058
1059 proc commit_tree {} {
1060         global HEAD commit_type file_states ui_comm repo_config
1061         global ui_status_value pch_error
1062
1063         if {[committer_ident] eq {}} return
1064         if {![lock_index update]} return
1065
1066         # -- Our in memory state should match the repository.
1067         #
1068         repository_state curType curHEAD curMERGE_HEAD
1069         if {[string match amend* $commit_type]
1070                 && $curType eq {normal}
1071                 && $curHEAD eq $HEAD} {
1072         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1073                 info_popup {Last scanned state does not match repository state.
1074
1075 Another Git program has modified this repository
1076 since the last scan.  A rescan must be performed
1077 before another commit can be created.
1078
1079 The rescan will be automatically started now.
1080 }
1081                 unlock_index
1082                 rescan {set ui_status_value {Ready.}}
1083                 return
1084         }
1085
1086         # -- At least one file should differ in the index.
1087         #
1088         set files_ready 0
1089         foreach path [array names file_states] {
1090                 switch -glob -- [lindex $file_states($path) 0] {
1091                 _? {continue}
1092                 A? -
1093                 D? -
1094                 M? {set files_ready 1}
1095                 U? {
1096                         error_popup "Unmerged files cannot be committed.
1097
1098 File [short_path $path] has merge conflicts.
1099 You must resolve them and add the file before committing.
1100 "
1101                         unlock_index
1102                         return
1103                 }
1104                 default {
1105                         error_popup "Unknown file state [lindex $s 0] detected.
1106
1107 File [short_path $path] cannot be committed by this program.
1108 "
1109                 }
1110                 }
1111         }
1112         if {!$files_ready} {
1113                 info_popup {No changes to commit.
1114
1115 You must add at least 1 file before you can commit.
1116 }
1117                 unlock_index
1118                 return
1119         }
1120
1121         # -- A message is required.
1122         #
1123         set msg [string trim [$ui_comm get 1.0 end]]
1124         regsub -all -line {[ \t\r]+$} $msg {} msg
1125         if {$msg eq {}} {
1126                 error_popup {Please supply a commit message.
1127
1128 A good commit message has the following format:
1129
1130 - First line: Describe in one sentance what you did.
1131 - Second line: Blank
1132 - Remaining lines: Describe why this change is good.
1133 }
1134                 unlock_index
1135                 return
1136         }
1137
1138         # -- Run the pre-commit hook.
1139         #
1140         set pchook [gitdir hooks pre-commit]
1141
1142         # On Cygwin [file executable] might lie so we need to ask
1143         # the shell if the hook is executable.  Yes that's annoying.
1144         #
1145         if {[is_Cygwin] && [file isfile $pchook]} {
1146                 set pchook [list sh -c [concat \
1147                         "if test -x \"$pchook\";" \
1148                         "then exec \"$pchook\" 2>&1;" \
1149                         "fi"]]
1150         } elseif {[file executable $pchook]} {
1151                 set pchook [list $pchook |& cat]
1152         } else {
1153                 commit_writetree $curHEAD $msg
1154                 return
1155         }
1156
1157         set ui_status_value {Calling pre-commit hook...}
1158         set pch_error {}
1159         set fd_ph [open "| $pchook" r]
1160         fconfigure $fd_ph -blocking 0 -translation binary
1161         fileevent $fd_ph readable \
1162                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1163 }
1164
1165 proc commit_prehook_wait {fd_ph curHEAD msg} {
1166         global pch_error ui_status_value
1167
1168         append pch_error [read $fd_ph]
1169         fconfigure $fd_ph -blocking 1
1170         if {[eof $fd_ph]} {
1171                 if {[catch {close $fd_ph}]} {
1172                         set ui_status_value {Commit declined by pre-commit hook.}
1173                         hook_failed_popup pre-commit $pch_error
1174                         unlock_index
1175                 } else {
1176                         commit_writetree $curHEAD $msg
1177                 }
1178                 set pch_error {}
1179                 return
1180         }
1181         fconfigure $fd_ph -blocking 0
1182 }
1183
1184 proc commit_writetree {curHEAD msg} {
1185         global ui_status_value
1186
1187         set ui_status_value {Committing changes...}
1188         set fd_wt [open "| git write-tree" r]
1189         fileevent $fd_wt readable \
1190                 [list commit_committree $fd_wt $curHEAD $msg]
1191 }
1192
1193 proc commit_committree {fd_wt curHEAD msg} {
1194         global HEAD PARENT MERGE_HEAD commit_type
1195         global all_heads current_branch
1196         global ui_status_value ui_comm selected_commit_type
1197         global file_states selected_paths rescan_active
1198         global repo_config
1199
1200         gets $fd_wt tree_id
1201         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1202                 error_popup "write-tree failed:\n\n$err"
1203                 set ui_status_value {Commit failed.}
1204                 unlock_index
1205                 return
1206         }
1207
1208         # -- Build the message.
1209         #
1210         set msg_p [gitdir COMMIT_EDITMSG]
1211         set msg_wt [open $msg_p w]
1212         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1213                 set enc utf-8
1214         }
1215         fconfigure $msg_wt -encoding $enc -translation binary
1216         puts -nonewline $msg_wt $msg
1217         close $msg_wt
1218
1219         # -- Create the commit.
1220         #
1221         set cmd [list git commit-tree $tree_id]
1222         set parents [concat $PARENT $MERGE_HEAD]
1223         if {[llength $parents] > 0} {
1224                 foreach p $parents {
1225                         lappend cmd -p $p
1226                 }
1227         } else {
1228                 # git commit-tree writes to stderr during initial commit.
1229                 lappend cmd 2>/dev/null
1230         }
1231         lappend cmd <$msg_p
1232         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1233                 error_popup "commit-tree failed:\n\n$err"
1234                 set ui_status_value {Commit failed.}
1235                 unlock_index
1236                 return
1237         }
1238
1239         # -- Update the HEAD ref.
1240         #
1241         set reflogm commit
1242         if {$commit_type ne {normal}} {
1243                 append reflogm " ($commit_type)"
1244         }
1245         set i [string first "\n" $msg]
1246         if {$i >= 0} {
1247                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1248         } else {
1249                 append reflogm {: } $msg
1250         }
1251         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1252         if {[catch {eval exec $cmd} err]} {
1253                 error_popup "update-ref failed:\n\n$err"
1254                 set ui_status_value {Commit failed.}
1255                 unlock_index
1256                 return
1257         }
1258
1259         # -- Make sure our current branch exists.
1260         #
1261         if {$commit_type eq {initial}} {
1262                 lappend all_heads $current_branch
1263                 set all_heads [lsort -unique $all_heads]
1264                 populate_branch_menu
1265         }
1266
1267         # -- Cleanup after ourselves.
1268         #
1269         catch {file delete $msg_p}
1270         catch {file delete [gitdir MERGE_HEAD]}
1271         catch {file delete [gitdir MERGE_MSG]}
1272         catch {file delete [gitdir SQUASH_MSG]}
1273         catch {file delete [gitdir GITGUI_MSG]}
1274
1275         # -- Let rerere do its thing.
1276         #
1277         if {[file isdirectory [gitdir rr-cache]]} {
1278                 catch {exec git rerere}
1279         }
1280
1281         # -- Run the post-commit hook.
1282         #
1283         set pchook [gitdir hooks post-commit]
1284         if {[is_Cygwin] && [file isfile $pchook]} {
1285                 set pchook [list sh -c [concat \
1286                         "if test -x \"$pchook\";" \
1287                         "then exec \"$pchook\";" \
1288                         "fi"]]
1289         } elseif {![file executable $pchook]} {
1290                 set pchook {}
1291         }
1292         if {$pchook ne {}} {
1293                 catch {exec $pchook &}
1294         }
1295
1296         $ui_comm delete 0.0 end
1297         $ui_comm edit reset
1298         $ui_comm edit modified false
1299
1300         if {[is_enabled singlecommit]} do_quit
1301
1302         # -- Update in memory status
1303         #
1304         set selected_commit_type new
1305         set commit_type normal
1306         set HEAD $cmt_id
1307         set PARENT $cmt_id
1308         set MERGE_HEAD [list]
1309
1310         foreach path [array names file_states] {
1311                 set s $file_states($path)
1312                 set m [lindex $s 0]
1313                 switch -glob -- $m {
1314                 _O -
1315                 _M -
1316                 _D {continue}
1317                 __ -
1318                 A_ -
1319                 M_ -
1320                 D_ {
1321                         unset file_states($path)
1322                         catch {unset selected_paths($path)}
1323                 }
1324                 DO {
1325                         set file_states($path) [list _O [lindex $s 1] {} {}]
1326                 }
1327                 AM -
1328                 AD -
1329                 MM -
1330                 MD {
1331                         set file_states($path) [list \
1332                                 _[string index $m 1] \
1333                                 [lindex $s 1] \
1334                                 [lindex $s 3] \
1335                                 {}]
1336                 }
1337                 }
1338         }
1339
1340         display_all_files
1341         unlock_index
1342         reshow_diff
1343         set ui_status_value \
1344                 "Changes committed as [string range $cmt_id 0 7]."
1345 }
1346
1347 ######################################################################
1348 ##
1349 ## fetch push
1350
1351 proc fetch_from {remote} {
1352         set w [new_console \
1353                 "fetch $remote" \
1354                 "Fetching new changes from $remote"]
1355         set cmd [list git fetch]
1356         lappend cmd $remote
1357         console_exec $w $cmd console_done
1358 }
1359
1360 proc push_to {remote} {
1361         set w [new_console \
1362                 "push $remote" \
1363                 "Pushing changes to $remote"]
1364         set cmd [list git push]
1365         lappend cmd -v
1366         lappend cmd $remote
1367         console_exec $w $cmd console_done
1368 }
1369
1370 ######################################################################
1371 ##
1372 ## ui helpers
1373
1374 proc mapicon {w state path} {
1375         global all_icons
1376
1377         if {[catch {set r $all_icons($state$w)}]} {
1378                 puts "error: no icon for $w state={$state} $path"
1379                 return file_plain
1380         }
1381         return $r
1382 }
1383
1384 proc mapdesc {state path} {
1385         global all_descs
1386
1387         if {[catch {set r $all_descs($state)}]} {
1388                 puts "error: no desc for state={$state} $path"
1389                 return $state
1390         }
1391         return $r
1392 }
1393
1394 proc escape_path {path} {
1395         regsub -all {\\} $path "\\\\" path
1396         regsub -all "\n" $path "\\n" path
1397         return $path
1398 }
1399
1400 proc short_path {path} {
1401         return [escape_path [lindex [file split $path] end]]
1402 }
1403
1404 set next_icon_id 0
1405 set null_sha1 [string repeat 0 40]
1406
1407 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1408         global file_states next_icon_id null_sha1
1409
1410         set s0 [string index $new_state 0]
1411         set s1 [string index $new_state 1]
1412
1413         if {[catch {set info $file_states($path)}]} {
1414                 set state __
1415                 set icon n[incr next_icon_id]
1416         } else {
1417                 set state [lindex $info 0]
1418                 set icon [lindex $info 1]
1419                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1420                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1421         }
1422
1423         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1424         elseif {$s0 eq {_}} {set s0 _}
1425
1426         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1427         elseif {$s1 eq {_}} {set s1 _}
1428
1429         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1430                 set head_info [list 0 $null_sha1]
1431         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1432                 && $head_info eq {}} {
1433                 set head_info $index_info
1434         }
1435
1436         set file_states($path) [list $s0$s1 $icon \
1437                 $head_info $index_info \
1438                 ]
1439         return $state
1440 }
1441
1442 proc display_file_helper {w path icon_name old_m new_m} {
1443         global file_lists
1444
1445         if {$new_m eq {_}} {
1446                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1447                 if {$lno >= 0} {
1448                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1449                         incr lno
1450                         $w conf -state normal
1451                         $w delete $lno.0 [expr {$lno + 1}].0
1452                         $w conf -state disabled
1453                 }
1454         } elseif {$old_m eq {_} && $new_m ne {_}} {
1455                 lappend file_lists($w) $path
1456                 set file_lists($w) [lsort -unique $file_lists($w)]
1457                 set lno [lsearch -sorted -exact $file_lists($w) $path]
1458                 incr lno
1459                 $w conf -state normal
1460                 $w image create $lno.0 \
1461                         -align center -padx 5 -pady 1 \
1462                         -name $icon_name \
1463                         -image [mapicon $w $new_m $path]
1464                 $w insert $lno.1 "[escape_path $path]\n"
1465                 $w conf -state disabled
1466         } elseif {$old_m ne $new_m} {
1467                 $w conf -state normal
1468                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1469                 $w conf -state disabled
1470         }
1471 }
1472
1473 proc display_file {path state} {
1474         global file_states selected_paths
1475         global ui_index ui_workdir
1476
1477         set old_m [merge_state $path $state]
1478         set s $file_states($path)
1479         set new_m [lindex $s 0]
1480         set icon_name [lindex $s 1]
1481
1482         set o [string index $old_m 0]
1483         set n [string index $new_m 0]
1484         if {$o eq {U}} {
1485                 set o _
1486         }
1487         if {$n eq {U}} {
1488                 set n _
1489         }
1490         display_file_helper     $ui_index $path $icon_name $o $n
1491
1492         if {[string index $old_m 0] eq {U}} {
1493                 set o U
1494         } else {
1495                 set o [string index $old_m 1]
1496         }
1497         if {[string index $new_m 0] eq {U}} {
1498                 set n U
1499         } else {
1500                 set n [string index $new_m 1]
1501         }
1502         display_file_helper     $ui_workdir $path $icon_name $o $n
1503
1504         if {$new_m eq {__}} {
1505                 unset file_states($path)
1506                 catch {unset selected_paths($path)}
1507         }
1508 }
1509
1510 proc display_all_files_helper {w path icon_name m} {
1511         global file_lists
1512
1513         lappend file_lists($w) $path
1514         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1515         $w image create end \
1516                 -align center -padx 5 -pady 1 \
1517                 -name $icon_name \
1518                 -image [mapicon $w $m $path]
1519         $w insert end "[escape_path $path]\n"
1520 }
1521
1522 proc display_all_files {} {
1523         global ui_index ui_workdir
1524         global file_states file_lists
1525         global last_clicked
1526
1527         $ui_index conf -state normal
1528         $ui_workdir conf -state normal
1529
1530         $ui_index delete 0.0 end
1531         $ui_workdir delete 0.0 end
1532         set last_clicked {}
1533
1534         set file_lists($ui_index) [list]
1535         set file_lists($ui_workdir) [list]
1536
1537         foreach path [lsort [array names file_states]] {
1538                 set s $file_states($path)
1539                 set m [lindex $s 0]
1540                 set icon_name [lindex $s 1]
1541
1542                 set s [string index $m 0]
1543                 if {$s ne {U} && $s ne {_}} {
1544                         display_all_files_helper $ui_index $path \
1545                                 $icon_name $s
1546                 }
1547
1548                 if {[string index $m 0] eq {U}} {
1549                         set s U
1550                 } else {
1551                         set s [string index $m 1]
1552                 }
1553                 if {$s ne {_}} {
1554                         display_all_files_helper $ui_workdir $path \
1555                                 $icon_name $s
1556                 }
1557         }
1558
1559         $ui_index conf -state disabled
1560         $ui_workdir conf -state disabled
1561 }
1562
1563 proc update_indexinfo {msg pathList after} {
1564         global update_index_cp ui_status_value
1565
1566         if {![lock_index update]} return
1567
1568         set update_index_cp 0
1569         set pathList [lsort $pathList]
1570         set totalCnt [llength $pathList]
1571         set batch [expr {int($totalCnt * .01) + 1}]
1572         if {$batch > 25} {set batch 25}
1573
1574         set ui_status_value [format \
1575                 "$msg... %i/%i files (%.2f%%)" \
1576                 $update_index_cp \
1577                 $totalCnt \
1578                 0.0]
1579         set fd [open "| git update-index -z --index-info" w]
1580         fconfigure $fd \
1581                 -blocking 0 \
1582                 -buffering full \
1583                 -buffersize 512 \
1584                 -encoding binary \
1585                 -translation binary
1586         fileevent $fd writable [list \
1587                 write_update_indexinfo \
1588                 $fd \
1589                 $pathList \
1590                 $totalCnt \
1591                 $batch \
1592                 $msg \
1593                 $after \
1594                 ]
1595 }
1596
1597 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1598         global update_index_cp ui_status_value
1599         global file_states current_diff_path
1600
1601         if {$update_index_cp >= $totalCnt} {
1602                 close $fd
1603                 unlock_index
1604                 uplevel #0 $after
1605                 return
1606         }
1607
1608         for {set i $batch} \
1609                 {$update_index_cp < $totalCnt && $i > 0} \
1610                 {incr i -1} {
1611                 set path [lindex $pathList $update_index_cp]
1612                 incr update_index_cp
1613
1614                 set s $file_states($path)
1615                 switch -glob -- [lindex $s 0] {
1616                 A? {set new _O}
1617                 M? {set new _M}
1618                 D_ {set new _D}
1619                 D? {set new _?}
1620                 ?? {continue}
1621                 }
1622                 set info [lindex $s 2]
1623                 if {$info eq {}} continue
1624
1625                 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1626                 display_file $path $new
1627         }
1628
1629         set ui_status_value [format \
1630                 "$msg... %i/%i files (%.2f%%)" \
1631                 $update_index_cp \
1632                 $totalCnt \
1633                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1634 }
1635
1636 proc update_index {msg pathList after} {
1637         global update_index_cp ui_status_value
1638
1639         if {![lock_index update]} return
1640
1641         set update_index_cp 0
1642         set pathList [lsort $pathList]
1643         set totalCnt [llength $pathList]
1644         set batch [expr {int($totalCnt * .01) + 1}]
1645         if {$batch > 25} {set batch 25}
1646
1647         set ui_status_value [format \
1648                 "$msg... %i/%i files (%.2f%%)" \
1649                 $update_index_cp \
1650                 $totalCnt \
1651                 0.0]
1652         set fd [open "| git update-index --add --remove -z --stdin" w]
1653         fconfigure $fd \
1654                 -blocking 0 \
1655                 -buffering full \
1656                 -buffersize 512 \
1657                 -encoding binary \
1658                 -translation binary
1659         fileevent $fd writable [list \
1660                 write_update_index \
1661                 $fd \
1662                 $pathList \
1663                 $totalCnt \
1664                 $batch \
1665                 $msg \
1666                 $after \
1667                 ]
1668 }
1669
1670 proc write_update_index {fd pathList totalCnt batch msg after} {
1671         global update_index_cp ui_status_value
1672         global file_states current_diff_path
1673
1674         if {$update_index_cp >= $totalCnt} {
1675                 close $fd
1676                 unlock_index
1677                 uplevel #0 $after
1678                 return
1679         }
1680
1681         for {set i $batch} \
1682                 {$update_index_cp < $totalCnt && $i > 0} \
1683                 {incr i -1} {
1684                 set path [lindex $pathList $update_index_cp]
1685                 incr update_index_cp
1686
1687                 switch -glob -- [lindex $file_states($path) 0] {
1688                 AD {set new __}
1689                 ?D {set new D_}
1690                 _O -
1691                 AM {set new A_}
1692                 U? {
1693                         if {[file exists $path]} {
1694                                 set new M_
1695                         } else {
1696                                 set new D_
1697                         }
1698                 }
1699                 ?M {set new M_}
1700                 ?? {continue}
1701                 }
1702                 puts -nonewline $fd "[encoding convertto $path]\0"
1703                 display_file $path $new
1704         }
1705
1706         set ui_status_value [format \
1707                 "$msg... %i/%i files (%.2f%%)" \
1708                 $update_index_cp \
1709                 $totalCnt \
1710                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1711 }
1712
1713 proc checkout_index {msg pathList after} {
1714         global update_index_cp ui_status_value
1715
1716         if {![lock_index update]} return
1717
1718         set update_index_cp 0
1719         set pathList [lsort $pathList]
1720         set totalCnt [llength $pathList]
1721         set batch [expr {int($totalCnt * .01) + 1}]
1722         if {$batch > 25} {set batch 25}
1723
1724         set ui_status_value [format \
1725                 "$msg... %i/%i files (%.2f%%)" \
1726                 $update_index_cp \
1727                 $totalCnt \
1728                 0.0]
1729         set cmd [list git checkout-index]
1730         lappend cmd --index
1731         lappend cmd --quiet
1732         lappend cmd --force
1733         lappend cmd -z
1734         lappend cmd --stdin
1735         set fd [open "| $cmd " w]
1736         fconfigure $fd \
1737                 -blocking 0 \
1738                 -buffering full \
1739                 -buffersize 512 \
1740                 -encoding binary \
1741                 -translation binary
1742         fileevent $fd writable [list \
1743                 write_checkout_index \
1744                 $fd \
1745                 $pathList \
1746                 $totalCnt \
1747                 $batch \
1748                 $msg \
1749                 $after \
1750                 ]
1751 }
1752
1753 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1754         global update_index_cp ui_status_value
1755         global file_states current_diff_path
1756
1757         if {$update_index_cp >= $totalCnt} {
1758                 close $fd
1759                 unlock_index
1760                 uplevel #0 $after
1761                 return
1762         }
1763
1764         for {set i $batch} \
1765                 {$update_index_cp < $totalCnt && $i > 0} \
1766                 {incr i -1} {
1767                 set path [lindex $pathList $update_index_cp]
1768                 incr update_index_cp
1769                 switch -glob -- [lindex $file_states($path) 0] {
1770                 U? {continue}
1771                 ?M -
1772                 ?D {
1773                         puts -nonewline $fd "[encoding convertto $path]\0"
1774                         display_file $path ?_
1775                 }
1776                 }
1777         }
1778
1779         set ui_status_value [format \
1780                 "$msg... %i/%i files (%.2f%%)" \
1781                 $update_index_cp \
1782                 $totalCnt \
1783                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1784 }
1785
1786 ######################################################################
1787 ##
1788 ## branch management
1789
1790 proc is_tracking_branch {name} {
1791         global tracking_branches
1792
1793         if {![catch {set info $tracking_branches($name)}]} {
1794                 return 1
1795         }
1796         foreach t [array names tracking_branches] {
1797                 if {[string match {*/\*} $t] && [string match $t $name]} {
1798                         return 1
1799                 }
1800         }
1801         return 0
1802 }
1803
1804 proc load_all_heads {} {
1805         global all_heads
1806
1807         set all_heads [list]
1808         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1809         while {[gets $fd line] > 0} {
1810                 if {[is_tracking_branch $line]} continue
1811                 if {![regsub ^refs/heads/ $line {} name]} continue
1812                 lappend all_heads $name
1813         }
1814         close $fd
1815
1816         set all_heads [lsort $all_heads]
1817 }
1818
1819 proc populate_branch_menu {} {
1820         global all_heads disable_on_lock
1821
1822         set m .mbar.branch
1823         set last [$m index last]
1824         for {set i 0} {$i <= $last} {incr i} {
1825                 if {[$m type $i] eq {separator}} {
1826                         $m delete $i last
1827                         set new_dol [list]
1828                         foreach a $disable_on_lock {
1829                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1830                                         lappend new_dol $a
1831                                 }
1832                         }
1833                         set disable_on_lock $new_dol
1834                         break
1835                 }
1836         }
1837
1838         if {$all_heads ne {}} {
1839                 $m add separator
1840         }
1841         foreach b $all_heads {
1842                 $m add radiobutton \
1843                         -label $b \
1844                         -command [list switch_branch $b] \
1845                         -variable current_branch \
1846                         -value $b \
1847                         -font font_ui
1848                 lappend disable_on_lock \
1849                         [list $m entryconf [$m index last] -state]
1850         }
1851 }
1852
1853 proc all_tracking_branches {} {
1854         global tracking_branches
1855
1856         set all_trackings {}
1857         set cmd {}
1858         foreach name [array names tracking_branches] {
1859                 if {[regsub {/\*$} $name {} name]} {
1860                         lappend cmd $name
1861                 } else {
1862                         regsub ^refs/(heads|remotes)/ $name {} name
1863                         lappend all_trackings $name
1864                 }
1865         }
1866
1867         if {$cmd ne {}} {
1868                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1869                 while {[gets $fd name] > 0} {
1870                         regsub ^refs/(heads|remotes)/ $name {} name
1871                         lappend all_trackings $name
1872                 }
1873                 close $fd
1874         }
1875
1876         return [lsort -unique $all_trackings]
1877 }
1878
1879 proc do_create_branch_action {w} {
1880         global all_heads null_sha1 repo_config
1881         global create_branch_checkout create_branch_revtype
1882         global create_branch_head create_branch_trackinghead
1883         global create_branch_name create_branch_revexp
1884
1885         set newbranch $create_branch_name
1886         if {$newbranch eq {}
1887                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1888                 tk_messageBox \
1889                         -icon error \
1890                         -type ok \
1891                         -title [wm title $w] \
1892                         -parent $w \
1893                         -message "Please supply a branch name."
1894                 focus $w.desc.name_t
1895                 return
1896         }
1897         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1898                 tk_messageBox \
1899                         -icon error \
1900                         -type ok \
1901                         -title [wm title $w] \
1902                         -parent $w \
1903                         -message "Branch '$newbranch' already exists."
1904                 focus $w.desc.name_t
1905                 return
1906         }
1907         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1908                 tk_messageBox \
1909                         -icon error \
1910                         -type ok \
1911                         -title [wm title $w] \
1912                         -parent $w \
1913                         -message "We do not like '$newbranch' as a branch name."
1914                 focus $w.desc.name_t
1915                 return
1916         }
1917
1918         set rev {}
1919         switch -- $create_branch_revtype {
1920         head {set rev $create_branch_head}
1921         tracking {set rev $create_branch_trackinghead}
1922         expression {set rev $create_branch_revexp}
1923         }
1924         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1925                 tk_messageBox \
1926                         -icon error \
1927                         -type ok \
1928                         -title [wm title $w] \
1929                         -parent $w \
1930                         -message "Invalid starting revision: $rev"
1931                 return
1932         }
1933         set cmd [list git update-ref]
1934         lappend cmd -m
1935         lappend cmd "branch: Created from $rev"
1936         lappend cmd "refs/heads/$newbranch"
1937         lappend cmd $cmt
1938         lappend cmd $null_sha1
1939         if {[catch {eval exec $cmd} err]} {
1940                 tk_messageBox \
1941                         -icon error \
1942                         -type ok \
1943                         -title [wm title $w] \
1944                         -parent $w \
1945                         -message "Failed to create '$newbranch'.\n\n$err"
1946                 return
1947         }
1948
1949         lappend all_heads $newbranch
1950         set all_heads [lsort $all_heads]
1951         populate_branch_menu
1952         destroy $w
1953         if {$create_branch_checkout} {
1954                 switch_branch $newbranch
1955         }
1956 }
1957
1958 proc radio_selector {varname value args} {
1959         upvar #0 $varname var
1960         set var $value
1961 }
1962
1963 trace add variable create_branch_head write \
1964         [list radio_selector create_branch_revtype head]
1965 trace add variable create_branch_trackinghead write \
1966         [list radio_selector create_branch_revtype tracking]
1967
1968 trace add variable delete_branch_head write \
1969         [list radio_selector delete_branch_checktype head]
1970 trace add variable delete_branch_trackinghead write \
1971         [list radio_selector delete_branch_checktype tracking]
1972
1973 proc do_create_branch {} {
1974         global all_heads current_branch repo_config
1975         global create_branch_checkout create_branch_revtype
1976         global create_branch_head create_branch_trackinghead
1977         global create_branch_name create_branch_revexp
1978
1979         set w .branch_editor
1980         toplevel $w
1981         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1982
1983         label $w.header -text {Create New Branch} \
1984                 -font font_uibold
1985         pack $w.header -side top -fill x
1986
1987         frame $w.buttons
1988         button $w.buttons.create -text Create \
1989                 -font font_ui \
1990                 -default active \
1991                 -command [list do_create_branch_action $w]
1992         pack $w.buttons.create -side right
1993         button $w.buttons.cancel -text {Cancel} \
1994                 -font font_ui \
1995                 -command [list destroy $w]
1996         pack $w.buttons.cancel -side right -padx 5
1997         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1998
1999         labelframe $w.desc \
2000                 -text {Branch Description} \
2001                 -font font_ui
2002         label $w.desc.name_l -text {Name:} -font font_ui
2003         entry $w.desc.name_t \
2004                 -borderwidth 1 \
2005                 -relief sunken \
2006                 -width 40 \
2007                 -textvariable create_branch_name \
2008                 -font font_ui \
2009                 -validate key \
2010                 -validatecommand {
2011                         if {%d == 1 && [regexp {[~^:?*\[\0- ]} %S]} {return 0}
2012                         return 1
2013                 }
2014         grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
2015         grid columnconfigure $w.desc 1 -weight 1
2016         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2017
2018         labelframe $w.from \
2019                 -text {Starting Revision} \
2020                 -font font_ui
2021         radiobutton $w.from.head_r \
2022                 -text {Local Branch:} \
2023                 -value head \
2024                 -variable create_branch_revtype \
2025                 -font font_ui
2026         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2027         grid $w.from.head_r $w.from.head_m -sticky w
2028         set all_trackings [all_tracking_branches]
2029         if {$all_trackings ne {}} {
2030                 set create_branch_trackinghead [lindex $all_trackings 0]
2031                 radiobutton $w.from.tracking_r \
2032                         -text {Tracking Branch:} \
2033                         -value tracking \
2034                         -variable create_branch_revtype \
2035                         -font font_ui
2036                 eval tk_optionMenu $w.from.tracking_m \
2037                         create_branch_trackinghead \
2038                         $all_trackings
2039                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2040         }
2041         radiobutton $w.from.exp_r \
2042                 -text {Revision Expression:} \
2043                 -value expression \
2044                 -variable create_branch_revtype \
2045                 -font font_ui
2046         entry $w.from.exp_t \
2047                 -borderwidth 1 \
2048                 -relief sunken \
2049                 -width 50 \
2050                 -textvariable create_branch_revexp \
2051                 -font font_ui \
2052                 -validate key \
2053                 -validatecommand {
2054                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2055                         if {%d == 1 && [string length %S] > 0} {
2056                                 set create_branch_revtype expression
2057                         }
2058                         return 1
2059                 }
2060         grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2061         grid columnconfigure $w.from 1 -weight 1
2062         pack $w.from -anchor nw -fill x -pady 5 -padx 5
2063
2064         labelframe $w.postActions \
2065                 -text {Post Creation Actions} \
2066                 -font font_ui
2067         checkbutton $w.postActions.checkout \
2068                 -text {Checkout after creation} \
2069                 -variable create_branch_checkout \
2070                 -font font_ui
2071         pack $w.postActions.checkout -anchor nw
2072         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2073
2074         set create_branch_checkout 1
2075         set create_branch_head $current_branch
2076         set create_branch_revtype head
2077         set create_branch_name $repo_config(gui.newbranchtemplate)
2078         set create_branch_revexp {}
2079
2080         bind $w <Visibility> "
2081                 grab $w
2082                 $w.desc.name_t icursor end
2083                 focus $w.desc.name_t
2084         "
2085         bind $w <Key-Escape> "destroy $w"
2086         bind $w <Key-Return> "do_create_branch_action $w;break"
2087         wm title $w "[appname] ([reponame]): Create Branch"
2088         tkwait window $w
2089 }
2090
2091 proc do_delete_branch_action {w} {
2092         global all_heads
2093         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2094
2095         set check_rev {}
2096         switch -- $delete_branch_checktype {
2097         head {set check_rev $delete_branch_head}
2098         tracking {set check_rev $delete_branch_trackinghead}
2099         always {set check_rev {:none}}
2100         }
2101         if {$check_rev eq {:none}} {
2102                 set check_cmt {}
2103         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2104                 tk_messageBox \
2105                         -icon error \
2106                         -type ok \
2107                         -title [wm title $w] \
2108                         -parent $w \
2109                         -message "Invalid check revision: $check_rev"
2110                 return
2111         }
2112
2113         set to_delete [list]
2114         set not_merged [list]
2115         foreach i [$w.list.l curselection] {
2116                 set b [$w.list.l get $i]
2117                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2118                 if {$check_cmt ne {}} {
2119                         if {$b eq $check_rev} continue
2120                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2121                         if {$o ne $m} {
2122                                 lappend not_merged $b
2123                                 continue
2124                         }
2125                 }
2126                 lappend to_delete [list $b $o]
2127         }
2128         if {$not_merged ne {}} {
2129                 set msg "The following branches are not completely merged into $check_rev:
2130
2131  - [join $not_merged "\n - "]"
2132                 tk_messageBox \
2133                         -icon info \
2134                         -type ok \
2135                         -title [wm title $w] \
2136                         -parent $w \
2137                         -message $msg
2138         }
2139         if {$to_delete eq {}} return
2140         if {$delete_branch_checktype eq {always}} {
2141                 set msg {Recovering deleted branches is difficult.
2142
2143 Delete the selected branches?}
2144                 if {[tk_messageBox \
2145                         -icon warning \
2146                         -type yesno \
2147                         -title [wm title $w] \
2148                         -parent $w \
2149                         -message $msg] ne yes} {
2150                         return
2151                 }
2152         }
2153
2154         set failed {}
2155         foreach i $to_delete {
2156                 set b [lindex $i 0]
2157                 set o [lindex $i 1]
2158                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2159                         append failed " - $b: $err\n"
2160                 } else {
2161                         set x [lsearch -sorted -exact $all_heads $b]
2162                         if {$x >= 0} {
2163                                 set all_heads [lreplace $all_heads $x $x]
2164                         }
2165                 }
2166         }
2167
2168         if {$failed ne {}} {
2169                 tk_messageBox \
2170                         -icon error \
2171                         -type ok \
2172                         -title [wm title $w] \
2173                         -parent $w \
2174                         -message "Failed to delete branches:\n$failed"
2175         }
2176
2177         set all_heads [lsort $all_heads]
2178         populate_branch_menu
2179         destroy $w
2180 }
2181
2182 proc do_delete_branch {} {
2183         global all_heads tracking_branches current_branch
2184         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2185
2186         set w .branch_editor
2187         toplevel $w
2188         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2189
2190         label $w.header -text {Delete Local Branch} \
2191                 -font font_uibold
2192         pack $w.header -side top -fill x
2193
2194         frame $w.buttons
2195         button $w.buttons.create -text Delete \
2196                 -font font_ui \
2197                 -command [list do_delete_branch_action $w]
2198         pack $w.buttons.create -side right
2199         button $w.buttons.cancel -text {Cancel} \
2200                 -font font_ui \
2201                 -command [list destroy $w]
2202         pack $w.buttons.cancel -side right -padx 5
2203         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2204
2205         labelframe $w.list \
2206                 -text {Local Branches} \
2207                 -font font_ui
2208         listbox $w.list.l \
2209                 -height 10 \
2210                 -width 70 \
2211                 -selectmode extended \
2212                 -yscrollcommand [list $w.list.sby set] \
2213                 -font font_ui
2214         foreach h $all_heads {
2215                 if {$h ne $current_branch} {
2216                         $w.list.l insert end $h
2217                 }
2218         }
2219         scrollbar $w.list.sby -command [list $w.list.l yview]
2220         pack $w.list.sby -side right -fill y
2221         pack $w.list.l -side left -fill both -expand 1
2222         pack $w.list -fill both -expand 1 -pady 5 -padx 5
2223
2224         labelframe $w.validate \
2225                 -text {Delete Only If} \
2226                 -font font_ui
2227         radiobutton $w.validate.head_r \
2228                 -text {Merged Into Local Branch:} \
2229                 -value head \
2230                 -variable delete_branch_checktype \
2231                 -font font_ui
2232         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2233         grid $w.validate.head_r $w.validate.head_m -sticky w
2234         set all_trackings [all_tracking_branches]
2235         if {$all_trackings ne {}} {
2236                 set delete_branch_trackinghead [lindex $all_trackings 0]
2237                 radiobutton $w.validate.tracking_r \
2238                         -text {Merged Into Tracking Branch:} \
2239                         -value tracking \
2240                         -variable delete_branch_checktype \
2241                         -font font_ui
2242                 eval tk_optionMenu $w.validate.tracking_m \
2243                         delete_branch_trackinghead \
2244                         $all_trackings
2245                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2246         }
2247         radiobutton $w.validate.always_r \
2248                 -text {Always (Do not perform merge checks)} \
2249                 -value always \
2250                 -variable delete_branch_checktype \
2251                 -font font_ui
2252         grid $w.validate.always_r -columnspan 2 -sticky w
2253         grid columnconfigure $w.validate 1 -weight 1
2254         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2255
2256         set delete_branch_head $current_branch
2257         set delete_branch_checktype head
2258
2259         bind $w <Visibility> "grab $w; focus $w"
2260         bind $w <Key-Escape> "destroy $w"
2261         wm title $w "[appname] ([reponame]): Delete Branch"
2262         tkwait window $w
2263 }
2264
2265 proc switch_branch {new_branch} {
2266         global HEAD commit_type current_branch repo_config
2267
2268         if {![lock_index switch]} return
2269
2270         # -- Our in memory state should match the repository.
2271         #
2272         repository_state curType curHEAD curMERGE_HEAD
2273         if {[string match amend* $commit_type]
2274                 && $curType eq {normal}
2275                 && $curHEAD eq $HEAD} {
2276         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2277                 info_popup {Last scanned state does not match repository state.
2278
2279 Another Git program has modified this repository
2280 since the last scan.  A rescan must be performed
2281 before the current branch can be changed.
2282
2283 The rescan will be automatically started now.
2284 }
2285                 unlock_index
2286                 rescan {set ui_status_value {Ready.}}
2287                 return
2288         }
2289
2290         # -- Don't do a pointless switch.
2291         #
2292         if {$current_branch eq $new_branch} {
2293                 unlock_index
2294                 return
2295         }
2296
2297         if {$repo_config(gui.trustmtime) eq {true}} {
2298                 switch_branch_stage2 {} $new_branch
2299         } else {
2300                 set ui_status_value {Refreshing file status...}
2301                 set cmd [list git update-index]
2302                 lappend cmd -q
2303                 lappend cmd --unmerged
2304                 lappend cmd --ignore-missing
2305                 lappend cmd --refresh
2306                 set fd_rf [open "| $cmd" r]
2307                 fconfigure $fd_rf -blocking 0 -translation binary
2308                 fileevent $fd_rf readable \
2309                         [list switch_branch_stage2 $fd_rf $new_branch]
2310         }
2311 }
2312
2313 proc switch_branch_stage2 {fd_rf new_branch} {
2314         global ui_status_value HEAD
2315
2316         if {$fd_rf ne {}} {
2317                 read $fd_rf
2318                 if {![eof $fd_rf]} return
2319                 close $fd_rf
2320         }
2321
2322         set ui_status_value "Updating working directory to '$new_branch'..."
2323         set cmd [list git read-tree]
2324         lappend cmd -m
2325         lappend cmd -u
2326         lappend cmd --exclude-per-directory=.gitignore
2327         lappend cmd $HEAD
2328         lappend cmd $new_branch
2329         set fd_rt [open "| $cmd" r]
2330         fconfigure $fd_rt -blocking 0 -translation binary
2331         fileevent $fd_rt readable \
2332                 [list switch_branch_readtree_wait $fd_rt $new_branch]
2333 }
2334
2335 proc switch_branch_readtree_wait {fd_rt new_branch} {
2336         global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2337         global current_branch
2338         global ui_comm ui_status_value
2339
2340         # -- We never get interesting output on stdout; only stderr.
2341         #
2342         read $fd_rt
2343         fconfigure $fd_rt -blocking 1
2344         if {![eof $fd_rt]} {
2345                 fconfigure $fd_rt -blocking 0
2346                 return
2347         }
2348
2349         # -- The working directory wasn't in sync with the index and
2350         #    we'd have to overwrite something to make the switch. A
2351         #    merge is required.
2352         #
2353         if {[catch {close $fd_rt} err]} {
2354                 regsub {^fatal: } $err {} err
2355                 warn_popup "File level merge required.
2356
2357 $err
2358
2359 Staying on branch '$current_branch'."
2360                 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2361                 unlock_index
2362                 return
2363         }
2364
2365         # -- Update the symbolic ref.  Core git doesn't even check for failure
2366         #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2367         #    state that is difficult to recover from within git-gui.
2368         #
2369         if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2370                 error_popup "Failed to set current branch.
2371
2372 This working directory is only partially switched.
2373 We successfully updated your files, but failed to
2374 update an internal Git file.
2375
2376 This should not have occurred.  [appname] will now
2377 close and give up.
2378
2379 $err"
2380                 do_quit
2381                 return
2382         }
2383
2384         # -- Update our repository state.  If we were previously in amend mode
2385         #    we need to toss the current buffer and do a full rescan to update
2386         #    our file lists.  If we weren't in amend mode our file lists are
2387         #    accurate and we can avoid the rescan.
2388         #
2389         unlock_index
2390         set selected_commit_type new
2391         if {[string match amend* $commit_type]} {
2392                 $ui_comm delete 0.0 end
2393                 $ui_comm edit reset
2394                 $ui_comm edit modified false
2395                 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2396         } else {
2397                 repository_state commit_type HEAD MERGE_HEAD
2398                 set PARENT $HEAD
2399                 set ui_status_value "Checked out branch '$current_branch'."
2400         }
2401 }
2402
2403 ######################################################################
2404 ##
2405 ## remote management
2406
2407 proc load_all_remotes {} {
2408         global repo_config
2409         global all_remotes tracking_branches
2410
2411         set all_remotes [list]
2412         array unset tracking_branches
2413
2414         set rm_dir [gitdir remotes]
2415         if {[file isdirectory $rm_dir]} {
2416                 set all_remotes [glob \
2417                         -types f \
2418                         -tails \
2419                         -nocomplain \
2420                         -directory $rm_dir *]
2421
2422                 foreach name $all_remotes {
2423                         catch {
2424                                 set fd [open [file join $rm_dir $name] r]
2425                                 while {[gets $fd line] >= 0} {
2426                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2427                                                 $line line src dst]} continue
2428                                         if {![regexp ^refs/ $dst]} {
2429                                                 set dst "refs/heads/$dst"
2430                                         }
2431                                         set tracking_branches($dst) [list $name $src]
2432                                 }
2433                                 close $fd
2434                         }
2435                 }
2436         }
2437
2438         foreach line [array names repo_config remote.*.url] {
2439                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2440                 lappend all_remotes $name
2441
2442                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2443                         set fl {}
2444                 }
2445                 foreach line $fl {
2446                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2447                         if {![regexp ^refs/ $dst]} {
2448                                 set dst "refs/heads/$dst"
2449                         }
2450                         set tracking_branches($dst) [list $name $src]
2451                 }
2452         }
2453
2454         set all_remotes [lsort -unique $all_remotes]
2455 }
2456
2457 proc populate_fetch_menu {} {
2458         global all_remotes repo_config
2459
2460         set m .mbar.fetch
2461         foreach r $all_remotes {
2462                 set enable 0
2463                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2464                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2465                                 set enable 1
2466                         }
2467                 } else {
2468                         catch {
2469                                 set fd [open [gitdir remotes $r] r]
2470                                 while {[gets $fd n] >= 0} {
2471                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2472                                                 set enable 1
2473                                                 break
2474                                         }
2475                                 }
2476                                 close $fd
2477                         }
2478                 }
2479
2480                 if {$enable} {
2481                         $m add command \
2482                                 -label "Fetch from $r..." \
2483                                 -command [list fetch_from $r] \
2484                                 -font font_ui
2485                 }
2486         }
2487 }
2488
2489 proc populate_push_menu {} {
2490         global all_remotes repo_config
2491
2492         set m .mbar.push
2493         set fast_count 0
2494         foreach r $all_remotes {
2495                 set enable 0
2496                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2497                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2498                                 set enable 1
2499                         }
2500                 } else {
2501                         catch {
2502                                 set fd [open [gitdir remotes $r] r]
2503                                 while {[gets $fd n] >= 0} {
2504                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2505                                                 set enable 1
2506                                                 break
2507                                         }
2508                                 }
2509                                 close $fd
2510                         }
2511                 }
2512
2513                 if {$enable} {
2514                         if {!$fast_count} {
2515                                 $m add separator
2516                         }
2517                         $m add command \
2518                                 -label "Push to $r..." \
2519                                 -command [list push_to $r] \
2520                                 -font font_ui
2521                         incr fast_count
2522                 }
2523         }
2524 }
2525
2526 proc start_push_anywhere_action {w} {
2527         global push_urltype push_remote push_url push_thin push_tags
2528
2529         set r_url {}
2530         switch -- $push_urltype {
2531         remote {set r_url $push_remote}
2532         url {set r_url $push_url}
2533         }
2534         if {$r_url eq {}} return
2535
2536         set cmd [list git push]
2537         lappend cmd -v
2538         if {$push_thin} {
2539                 lappend cmd --thin
2540         }
2541         if {$push_tags} {
2542                 lappend cmd --tags
2543         }
2544         lappend cmd $r_url
2545         set cnt 0
2546         foreach i [$w.source.l curselection] {
2547                 set b [$w.source.l get $i]
2548                 lappend cmd "refs/heads/$b:refs/heads/$b"
2549                 incr cnt
2550         }
2551         if {$cnt == 0} {
2552                 return
2553         } elseif {$cnt == 1} {
2554                 set unit branch
2555         } else {
2556                 set unit branches
2557         }
2558
2559         set cons [new_console "push $r_url" "Pushing $cnt $unit to $r_url"]
2560         console_exec $cons $cmd console_done
2561         destroy $w
2562 }
2563
2564 trace add variable push_remote write \
2565         [list radio_selector push_urltype remote]
2566
2567 proc do_push_anywhere {} {
2568         global all_heads all_remotes current_branch
2569         global push_urltype push_remote push_url push_thin push_tags
2570
2571         set w .push_setup
2572         toplevel $w
2573         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2574
2575         label $w.header -text {Push Branches} -font font_uibold
2576         pack $w.header -side top -fill x
2577
2578         frame $w.buttons
2579         button $w.buttons.create -text Push \
2580                 -font font_ui \
2581                 -command [list start_push_anywhere_action $w]
2582         pack $w.buttons.create -side right
2583         button $w.buttons.cancel -text {Cancel} \
2584                 -font font_ui \
2585                 -command [list destroy $w]
2586         pack $w.buttons.cancel -side right -padx 5
2587         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2588
2589         labelframe $w.source \
2590                 -text {Source Branches} \
2591                 -font font_ui
2592         listbox $w.source.l \
2593                 -height 10 \
2594                 -width 70 \
2595                 -selectmode extended \
2596                 -yscrollcommand [list $w.source.sby set] \
2597                 -font font_ui
2598         foreach h $all_heads {
2599                 $w.source.l insert end $h
2600                 if {$h eq $current_branch} {
2601                         $w.source.l select set end
2602                 }
2603         }
2604         scrollbar $w.source.sby -command [list $w.source.l yview]
2605         pack $w.source.sby -side right -fill y
2606         pack $w.source.l -side left -fill both -expand 1
2607         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2608
2609         labelframe $w.dest \
2610                 -text {Destination Repository} \
2611                 -font font_ui
2612         if {$all_remotes ne {}} {
2613                 radiobutton $w.dest.remote_r \
2614                         -text {Remote:} \
2615                         -value remote \
2616                         -variable push_urltype \
2617                         -font font_ui
2618                 eval tk_optionMenu $w.dest.remote_m push_remote $all_remotes
2619                 grid $w.dest.remote_r $w.dest.remote_m -sticky w
2620                 if {[lsearch -sorted -exact $all_remotes origin] != -1} {
2621                         set push_remote origin
2622                 } else {
2623                         set push_remote [lindex $all_remotes 0]
2624                 }
2625                 set push_urltype remote
2626         } else {
2627                 set push_urltype url
2628         }
2629         radiobutton $w.dest.url_r \
2630                 -text {Arbitrary URL:} \
2631                 -value url \
2632                 -variable push_urltype \
2633                 -font font_ui
2634         entry $w.dest.url_t \
2635                 -borderwidth 1 \
2636                 -relief sunken \
2637                 -width 50 \
2638                 -textvariable push_url \
2639                 -font font_ui \
2640                 -validate key \
2641                 -validatecommand {
2642                         if {%d == 1 && [regexp {\s} %S]} {return 0}
2643                         if {%d == 1 && [string length %S] > 0} {
2644                                 set push_urltype url
2645                         }
2646                         return 1
2647                 }
2648         grid $w.dest.url_r $w.dest.url_t -sticky we -padx {0 5}
2649         grid columnconfigure $w.dest 1 -weight 1
2650         pack $w.dest -anchor nw -fill x -pady 5 -padx 5
2651
2652         labelframe $w.options \
2653                 -text {Transfer Options} \
2654                 -font font_ui
2655         checkbutton $w.options.thin \
2656                 -text {Use thin pack (for slow network connections)} \
2657                 -variable push_thin \
2658                 -font font_ui
2659         grid $w.options.thin -columnspan 2 -sticky w
2660         checkbutton $w.options.tags \
2661                 -text {Include tags} \
2662                 -variable push_tags \
2663                 -font font_ui
2664         grid $w.options.tags -columnspan 2 -sticky w
2665         grid columnconfigure $w.options 1 -weight 1
2666         pack $w.options -anchor nw -fill x -pady 5 -padx 5
2667
2668         set push_url {}
2669         set push_thin 0
2670         set push_tags 0
2671
2672         bind $w <Visibility> "grab $w"
2673         bind $w <Key-Escape> "destroy $w"
2674         wm title $w "[appname] ([reponame]): Push"
2675         tkwait window $w
2676 }
2677
2678 ######################################################################
2679 ##
2680 ## merge
2681
2682 proc can_merge {} {
2683         global HEAD commit_type file_states
2684
2685         if {[string match amend* $commit_type]} {
2686                 info_popup {Cannot merge while amending.
2687
2688 You must finish amending this commit before
2689 starting any type of merge.
2690 }
2691                 return 0
2692         }
2693
2694         if {[committer_ident] eq {}} {return 0}
2695         if {![lock_index merge]} {return 0}
2696
2697         # -- Our in memory state should match the repository.
2698         #
2699         repository_state curType curHEAD curMERGE_HEAD
2700         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
2701                 info_popup {Last scanned state does not match repository state.
2702
2703 Another Git program has modified this repository
2704 since the last scan.  A rescan must be performed
2705 before a merge can be performed.
2706
2707 The rescan will be automatically started now.
2708 }
2709                 unlock_index
2710                 rescan {set ui_status_value {Ready.}}
2711                 return 0
2712         }
2713
2714         foreach path [array names file_states] {
2715                 switch -glob -- [lindex $file_states($path) 0] {
2716                 _O {
2717                         continue; # and pray it works!
2718                 }
2719                 U? {
2720                         error_popup "You are in the middle of a conflicted merge.
2721
2722 File [short_path $path] has merge conflicts.
2723
2724 You must resolve them, add the file, and commit to
2725 complete the current merge.  Only then can you
2726 begin another merge.
2727 "
2728                         unlock_index
2729                         return 0
2730                 }
2731                 ?? {
2732                         error_popup "You are in the middle of a change.
2733
2734 File [short_path $path] is modified.
2735
2736 You should complete the current commit before
2737 starting a merge.  Doing so will help you abort
2738 a failed merge, should the need arise.
2739 "
2740                         unlock_index
2741                         return 0
2742                 }
2743                 }
2744         }
2745
2746         return 1
2747 }
2748
2749 proc visualize_local_merge {w} {
2750         set revs {}
2751         foreach i [$w.source.l curselection] {
2752                 lappend revs [$w.source.l get $i]
2753         }
2754         if {$revs eq {}} return
2755         lappend revs --not HEAD
2756         do_gitk $revs
2757 }
2758
2759 proc start_local_merge_action {w} {
2760         global HEAD ui_status_value current_branch
2761
2762         set cmd [list git merge]
2763         set names {}
2764         set revcnt 0
2765         foreach i [$w.source.l curselection] {
2766                 set b [$w.source.l get $i]
2767                 lappend cmd $b
2768                 lappend names $b
2769                 incr revcnt
2770         }
2771
2772         if {$revcnt == 0} {
2773                 return
2774         } elseif {$revcnt == 1} {
2775                 set unit branch
2776         } elseif {$revcnt <= 15} {
2777                 set unit branches
2778         } else {
2779                 tk_messageBox \
2780                         -icon error \
2781                         -type ok \
2782                         -title [wm title $w] \
2783                         -parent $w \
2784                         -message "Too many branches selected.
2785
2786 You have requested to merge $revcnt branches
2787 in an octopus merge.  This exceeds Git's
2788 internal limit of 15 branches per merge.
2789
2790 Please select fewer branches.  To merge more
2791 than 15 branches, merge the branches in batches.
2792 "
2793                 return
2794         }
2795
2796         set msg "Merging $current_branch, [join $names {, }]"
2797         set ui_status_value "$msg..."
2798         set cons [new_console "Merge" $msg]
2799         console_exec $cons $cmd [list finish_merge $revcnt]
2800         bind $w <Destroy> {}
2801         destroy $w
2802 }
2803
2804 proc finish_merge {revcnt w ok} {
2805         console_done $w $ok
2806         if {$ok} {
2807                 set msg {Merge completed successfully.}
2808         } else {
2809                 if {$revcnt != 1} {
2810                         info_popup "Octopus merge failed.
2811
2812 Your merge of $revcnt branches has failed.
2813
2814 There are file-level conflicts between the
2815 branches which must be resolved manually.
2816
2817 The working directory will now be reset.
2818
2819 You can attempt this merge again
2820 by merging only one branch at a time." $w
2821
2822                         set fd [open "| git read-tree --reset -u HEAD" r]
2823                         fconfigure $fd -blocking 0 -translation binary
2824                         fileevent $fd readable [list reset_hard_wait $fd]
2825                         set ui_status_value {Aborting... please wait...}
2826                         return
2827                 }
2828
2829                 set msg {Merge failed.  Conflict resolution is required.}
2830         }
2831         unlock_index
2832         rescan [list set ui_status_value $msg]
2833 }
2834
2835 proc do_local_merge {} {
2836         global current_branch
2837
2838         if {![can_merge]} return
2839
2840         set w .merge_setup
2841         toplevel $w
2842         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2843
2844         label $w.header \
2845                 -text "Merge Into $current_branch" \
2846                 -font font_uibold
2847         pack $w.header -side top -fill x
2848
2849         frame $w.buttons
2850         button $w.buttons.visualize -text Visualize \
2851                 -font font_ui \
2852                 -command [list visualize_local_merge $w]
2853         pack $w.buttons.visualize -side left
2854         button $w.buttons.create -text Merge \
2855                 -font font_ui \
2856                 -command [list start_local_merge_action $w]
2857         pack $w.buttons.create -side right
2858         button $w.buttons.cancel -text {Cancel} \
2859                 -font font_ui \
2860                 -command [list destroy $w]
2861         pack $w.buttons.cancel -side right -padx 5
2862         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2863
2864         labelframe $w.source \
2865                 -text {Source Branches} \
2866                 -font font_ui
2867         listbox $w.source.l \
2868                 -height 10 \
2869                 -width 70 \
2870                 -selectmode extended \
2871                 -yscrollcommand [list $w.source.sby set] \
2872                 -font font_ui
2873         scrollbar $w.source.sby -command [list $w.source.l yview]
2874         pack $w.source.sby -side right -fill y
2875         pack $w.source.l -side left -fill both -expand 1
2876         pack $w.source -fill both -expand 1 -pady 5 -padx 5
2877
2878         set cmd [list git for-each-ref]
2879         lappend cmd {--format=%(objectname) %(refname)}
2880         lappend cmd refs/heads
2881         lappend cmd refs/remotes
2882         set fr_fd [open "| $cmd" r]
2883         fconfigure $fr_fd -translation binary
2884         while {[gets $fr_fd line] > 0} {
2885                 set line [split $line { }]
2886                 set sha1([lindex $line 0]) [lindex $line 1]
2887         }
2888         close $fr_fd
2889
2890         set to_show {}
2891         set fr_fd [open "| git rev-list --all --not HEAD"]
2892         while {[gets $fr_fd line] > 0} {
2893                 if {[catch {set ref $sha1($line)}]} continue
2894                 regsub ^refs/(heads|remotes)/ $ref {} ref
2895                 lappend to_show $ref
2896         }
2897         close $fr_fd
2898
2899         foreach ref [lsort -unique $to_show] {
2900                 $w.source.l insert end $ref
2901         }
2902
2903         bind $w <Visibility> "grab $w"
2904         bind $w <Key-Escape> "unlock_index;destroy $w"
2905         bind $w <Destroy> unlock_index
2906         wm title $w "[appname] ([reponame]): Merge"
2907         tkwait window $w
2908 }
2909
2910 proc do_reset_hard {} {
2911         global HEAD commit_type file_states
2912
2913         if {[string match amend* $commit_type]} {
2914                 info_popup {Cannot abort while amending.
2915
2916 You must finish amending this commit.
2917 }
2918                 return
2919         }
2920
2921         if {![lock_index abort]} return
2922
2923         if {[string match *merge* $commit_type]} {
2924                 set op merge
2925         } else {
2926                 set op commit
2927         }
2928
2929         if {[ask_popup "Abort $op?
2930
2931 Aborting the current $op will cause
2932 *ALL* uncommitted changes to be lost.
2933
2934 Continue with aborting the current $op?"] eq {yes}} {
2935                 set fd [open "| git read-tree --reset -u HEAD" r]
2936                 fconfigure $fd -blocking 0 -translation binary
2937                 fileevent $fd readable [list reset_hard_wait $fd]
2938                 set ui_status_value {Aborting... please wait...}
2939         } else {
2940                 unlock_index
2941         }
2942 }
2943
2944 proc reset_hard_wait {fd} {
2945         global ui_comm
2946
2947         read $fd
2948         if {[eof $fd]} {
2949                 close $fd
2950                 unlock_index
2951
2952                 $ui_comm delete 0.0 end
2953                 $ui_comm edit modified false
2954
2955                 catch {file delete [gitdir MERGE_HEAD]}
2956                 catch {file delete [gitdir rr-cache MERGE_RR]}
2957                 catch {file delete [gitdir SQUASH_MSG]}
2958                 catch {file delete [gitdir MERGE_MSG]}
2959                 catch {file delete [gitdir GITGUI_MSG]}
2960
2961                 rescan {set ui_status_value {Abort completed.  Ready.}}
2962         }
2963 }
2964
2965 ######################################################################
2966 ##
2967 ## browser
2968
2969 set next_browser_id 0
2970
2971 proc new_browser {commit} {
2972         global next_browser_id cursor_ptr M1B
2973         global browser_commit browser_status browser_stack browser_path browser_busy
2974
2975         set w .browser[incr next_browser_id]
2976         set w_list $w.list.l
2977         set browser_commit($w_list) $commit
2978         set browser_status($w_list) {Starting...}
2979         set browser_stack($w_list) {}
2980         set browser_path($w_list) $browser_commit($w_list):
2981         set browser_busy($w_list) 1
2982
2983         toplevel $w
2984         label $w.path -textvariable browser_path($w_list) \
2985                 -anchor w \
2986                 -justify left \
2987                 -borderwidth 1 \
2988                 -relief sunken \
2989                 -font font_uibold
2990         pack $w.path -anchor w -side top -fill x
2991
2992         frame $w.list
2993         text $w_list -background white -borderwidth 0 \
2994                 -cursor $cursor_ptr \
2995                 -state disabled \
2996                 -wrap none \
2997                 -height 20 \
2998                 -width 70 \
2999                 -xscrollcommand [list $w.list.sbx set] \
3000                 -yscrollcommand [list $w.list.sby set] \
3001                 -font font_ui
3002         $w_list tag conf in_sel \
3003                 -background [$w_list cget -foreground] \
3004                 -foreground [$w_list cget -background]
3005         scrollbar $w.list.sbx -orient h -command [list $w_list xview]
3006         scrollbar $w.list.sby -orient v -command [list $w_list yview]
3007         pack $w.list.sbx -side bottom -fill x
3008         pack $w.list.sby -side right -fill y
3009         pack $w_list -side left -fill both -expand 1
3010         pack $w.list -side top -fill both -expand 1
3011
3012         label $w.status -textvariable browser_status($w_list) \
3013                 -anchor w \
3014                 -justify left \
3015                 -borderwidth 1 \
3016                 -relief sunken \
3017                 -font font_ui
3018         pack $w.status -anchor w -side bottom -fill x
3019
3020         bind $w_list <Button-1>        "browser_click 0 $w_list @%x,%y;break"
3021         bind $w_list <Double-Button-1> "browser_click 1 $w_list @%x,%y;break"
3022         bind $w_list <$M1B-Up>         "browser_parent $w_list;break"
3023         bind $w_list <$M1B-Left>       "browser_parent $w_list;break"
3024         bind $w_list <Up>              "browser_move -1 $w_list;break"
3025         bind $w_list <Down>            "browser_move 1 $w_list;break"
3026         bind $w_list <$M1B-Right>      "browser_enter $w_list;break"
3027         bind $w_list <Return>          "browser_enter $w_list;break"
3028         bind $w_list <Prior>           "browser_page -1 $w_list;break"
3029         bind $w_list <Next>            "browser_page 1 $w_list;break"
3030         bind $w_list <Left>            break
3031         bind $w_list <Right>           break
3032
3033         bind $w <Visibility> "focus $w"
3034         bind $w <Destroy> "
3035                 array unset browser_buffer $w_list
3036                 array unset browser_files $w_list
3037                 array unset browser_status $w_list
3038                 array unset browser_stack $w_list
3039                 array unset browser_path $w_list
3040                 array unset browser_commit $w_list
3041                 array unset browser_busy $w_list
3042         "
3043         wm title $w "[appname] ([reponame]): File Browser"
3044         ls_tree $w_list $browser_commit($w_list) {}
3045 }
3046
3047 proc browser_move {dir w} {
3048         global browser_files browser_busy
3049
3050         if {$browser_busy($w)} return
3051         set lno [lindex [split [$w index in_sel.first] .] 0]
3052         incr lno $dir
3053         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3054                 $w tag remove in_sel 0.0 end
3055                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3056                 $w see $lno.0
3057         }
3058 }
3059
3060 proc browser_page {dir w} {
3061         global browser_files browser_busy
3062
3063         if {$browser_busy($w)} return
3064         $w yview scroll $dir pages
3065         set lno [expr {int(
3066                   [lindex [$w yview] 0]
3067                 * [llength $browser_files($w)]
3068                 + 1)}]
3069         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3070                 $w tag remove in_sel 0.0 end
3071                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3072                 $w see $lno.0
3073         }
3074 }
3075
3076 proc browser_parent {w} {
3077         global browser_files browser_status browser_path
3078         global browser_stack browser_busy
3079
3080         if {$browser_busy($w)} return
3081         set info [lindex $browser_files($w) 0]
3082         if {[lindex $info 0] eq {parent}} {
3083                 set parent [lindex $browser_stack($w) end-1]
3084                 set browser_stack($w) [lrange $browser_stack($w) 0 end-2]
3085                 if {$browser_stack($w) eq {}} {
3086                         regsub {:.*$} $browser_path($w) {:} browser_path($w)
3087                 } else {
3088                         regsub {/[^/]+$} $browser_path($w) {} browser_path($w)
3089                 }
3090                 set browser_status($w) "Loading $browser_path($w)..."
3091                 ls_tree $w [lindex $parent 0] [lindex $parent 1]
3092         }
3093 }
3094
3095 proc browser_enter {w} {
3096         global browser_files browser_status browser_path
3097         global browser_commit browser_stack browser_busy
3098
3099         if {$browser_busy($w)} return
3100         set lno [lindex [split [$w index in_sel.first] .] 0]
3101         set info [lindex $browser_files($w) [expr {$lno - 1}]]
3102         if {$info ne {}} {
3103                 switch -- [lindex $info 0] {
3104                 parent {
3105                         browser_parent $w
3106                 }
3107                 tree {
3108                         set name [lindex $info 2]
3109                         set escn [escape_path $name]
3110                         set browser_status($w) "Loading $escn..."
3111                         append browser_path($w) $escn
3112                         ls_tree $w [lindex $info 1] $name
3113                 }
3114                 blob {
3115                         set name [lindex $info 2]
3116                         set p {}
3117                         foreach n $browser_stack($w) {
3118                                 append p [lindex $n 1]
3119                         }
3120                         append p $name
3121                         show_blame $browser_commit($w) $p
3122                 }
3123                 }
3124         }
3125 }
3126
3127 proc browser_click {was_double_click w pos} {
3128         global browser_files browser_busy
3129
3130         if {$browser_busy($w)} return
3131         set lno [lindex [split [$w index $pos] .] 0]
3132         focus $w
3133
3134         if {[lindex $browser_files($w) [expr {$lno - 1}]] ne {}} {
3135                 $w tag remove in_sel 0.0 end
3136                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3137                 if {$was_double_click} {
3138                         browser_enter $w
3139                 }
3140         }
3141 }
3142
3143 proc ls_tree {w tree_id name} {
3144         global browser_buffer browser_files browser_stack browser_busy
3145
3146         set browser_buffer($w) {}
3147         set browser_files($w) {}
3148         set browser_busy($w) 1
3149
3150         $w conf -state normal
3151         $w tag remove in_sel 0.0 end
3152         $w delete 0.0 end
3153         if {$browser_stack($w) ne {}} {
3154                 $w image create end \
3155                         -align center -padx 5 -pady 1 \
3156                         -name icon0 \
3157                         -image file_uplevel
3158                 $w insert end {[Up To Parent]}
3159                 lappend browser_files($w) parent
3160         }
3161         lappend browser_stack($w) [list $tree_id $name]
3162         $w conf -state disabled
3163
3164         set cmd [list git ls-tree -z $tree_id]
3165         set fd [open "| $cmd" r]
3166         fconfigure $fd -blocking 0 -translation binary -encoding binary
3167         fileevent $fd readable [list read_ls_tree $fd $w]
3168 }
3169
3170 proc read_ls_tree {fd w} {
3171         global browser_buffer browser_files browser_status browser_busy
3172
3173         if {![winfo exists $w]} {
3174                 catch {close $fd}
3175                 return
3176         }
3177
3178         append browser_buffer($w) [read $fd]
3179         set pck [split $browser_buffer($w) "\0"]
3180         set browser_buffer($w) [lindex $pck end]
3181
3182         set n [llength $browser_files($w)]
3183         $w conf -state normal
3184         foreach p [lrange $pck 0 end-1] {
3185                 set info [split $p "\t"]
3186                 set path [lindex $info 1]
3187                 set info [split [lindex $info 0] { }]
3188                 set type [lindex $info 1]
3189                 set object [lindex $info 2]
3190
3191                 switch -- $type {
3192                 blob {
3193                         set image file_mod
3194                 }
3195                 tree {
3196                         set image file_dir
3197                         append path /
3198                 }
3199                 default {
3200                         set image file_question
3201                 }
3202                 }
3203
3204                 if {$n > 0} {$w insert end "\n"}
3205                 $w image create end \
3206                         -align center -padx 5 -pady 1 \
3207                         -name icon[incr n] \
3208                         -image $image
3209                 $w insert end [escape_path $path]
3210                 lappend browser_files($w) [list $type $object $path]
3211         }
3212         $w conf -state disabled
3213
3214         if {[eof $fd]} {
3215                 close $fd
3216                 set browser_status($w) Ready.
3217                 set browser_busy($w) 0
3218                 array unset browser_buffer $w
3219                 if {$n > 0} {
3220                         $w tag add in_sel 1.0 2.0
3221                         focus -force $w
3222                 }
3223         }
3224 }
3225
3226 proc show_blame {commit path} {
3227         global next_browser_id blame_status blame_data
3228
3229         if {[winfo ismapped .]} {
3230                 set w .browser[incr next_browser_id]
3231                 set tl $w
3232                 toplevel $w
3233         } else {
3234                 set w {}
3235                 set tl .
3236         }
3237         set blame_status($w) {Loading current file content...}
3238
3239         label $w.path -text "$commit:$path" \
3240                 -anchor w \
3241                 -justify left \
3242                 -borderwidth 1 \
3243                 -relief sunken \
3244                 -font font_uibold
3245         pack $w.path -side top -fill x
3246
3247         frame $w.out
3248         text $w.out.loaded_t \
3249                 -background white -borderwidth 0 \
3250                 -state disabled \
3251                 -wrap none \
3252                 -height 40 \
3253                 -width 1 \
3254                 -font font_diff
3255         $w.out.loaded_t tag conf annotated -background grey
3256
3257         text $w.out.linenumber_t \
3258                 -background white -borderwidth 0 \
3259                 -state disabled \
3260                 -wrap none \
3261                 -height 40 \
3262                 -width 5 \
3263                 -font font_diff
3264         $w.out.linenumber_t tag conf linenumber -justify right
3265
3266         text $w.out.file_t \
3267                 -background white -borderwidth 0 \
3268                 -state disabled \
3269                 -wrap none \
3270                 -height 40 \
3271                 -width 80 \
3272                 -xscrollcommand [list $w.out.sbx set] \
3273                 -font font_diff
3274
3275         scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3276         scrollbar $w.out.sby -orient v \
3277                 -command [list scrollbar2many [list \
3278                 $w.out.loaded_t \
3279                 $w.out.linenumber_t \
3280                 $w.out.file_t \
3281                 ] yview]
3282         grid \
3283                 $w.out.linenumber_t \
3284                 $w.out.loaded_t \
3285                 $w.out.file_t \
3286                 $w.out.sby \
3287                 -sticky nsew
3288         grid conf $w.out.sbx -column 2 -sticky we
3289         grid columnconfigure $w.out 2 -weight 1
3290         grid rowconfigure $w.out 0 -weight 1
3291         pack $w.out -fill both -expand 1
3292
3293         label $w.status -textvariable blame_status($w) \
3294                 -anchor w \
3295                 -justify left \
3296                 -borderwidth 1 \
3297                 -relief sunken \
3298                 -font font_ui
3299         pack $w.status -side bottom -fill x
3300
3301         frame $w.cm
3302         text $w.cm.t \
3303                 -background white -borderwidth 0 \
3304                 -state disabled \
3305                 -wrap none \
3306                 -height 10 \
3307                 -width 80 \
3308                 -xscrollcommand [list $w.cm.sbx set] \
3309                 -yscrollcommand [list $w.cm.sby set] \
3310                 -font font_diff
3311         scrollbar $w.cm.sbx -orient h -command [list $w.cm.t xview]
3312         scrollbar $w.cm.sby -orient v -command [list $w.cm.t yview]
3313         pack $w.cm.sby -side right -fill y
3314         pack $w.cm.sbx -side bottom -fill x
3315         pack $w.cm.t -expand 1 -fill both
3316         pack $w.cm -side bottom -fill x
3317
3318         menu $w.ctxm -tearoff 0
3319         $w.ctxm add command -label "Copy Commit" \
3320                 -font font_ui \
3321                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3322
3323         foreach i [list \
3324                 $w.out.loaded_t \
3325                 $w.out.linenumber_t \
3326                 $w.out.file_t] {
3327                 $i tag conf in_sel \
3328                         -background [$i cget -foreground] \
3329                         -foreground [$i cget -background]
3330                 $i conf -yscrollcommand \
3331                         [list many2scrollbar [list \
3332                         $w.out.loaded_t \
3333                         $w.out.linenumber_t \
3334                         $w.out.file_t \
3335                         ] yview $w.out.sby]
3336                 bind $i <Button-1> "
3337                         blame_click {$w} \\
3338                                 $w.cm.t \\
3339                                 $w.out.linenumber_t \\
3340                                 $w.out.file_t \\
3341                                 $i @%x,%y
3342                         focus $i
3343                 "
3344                 bind_button3 $i "
3345                         set cursorX %x
3346                         set cursorY %y
3347                         set cursorW %W
3348                         tk_popup $w.ctxm %X %Y
3349                 "
3350         }
3351
3352         bind $w.cm.t <Button-1> "focus $w.cm.t"
3353         bind $tl <Visibility> "focus $tl"
3354         bind $tl <Destroy> "
3355                 array unset blame_status {$w}
3356                 array unset blame_data $w,*
3357         "
3358         wm title $tl "[appname] ([reponame]): File Viewer"
3359
3360         set blame_data($w,commit_count) 0
3361         set blame_data($w,commit_list) {}
3362         set blame_data($w,total_lines) 0
3363         set blame_data($w,blame_lines) 0
3364         set blame_data($w,highlight_commit) {}
3365         set blame_data($w,highlight_line) -1
3366
3367         set cmd [list git cat-file blob "$commit:$path"]
3368         set fd [open "| $cmd" r]
3369         fconfigure $fd -blocking 0 -translation lf -encoding binary
3370         fileevent $fd readable [list read_blame_catfile \
3371                 $fd $w $commit $path \
3372                 $w.cm.t $w.out.loaded_t $w.out.linenumber_t $w.out.file_t]
3373 }
3374
3375 proc read_blame_catfile {fd w commit path w_cmit w_load w_line w_file} {
3376         global blame_status blame_data
3377
3378         if {![winfo exists $w_file]} {
3379                 catch {close $fd}
3380                 return
3381         }
3382
3383         set n $blame_data($w,total_lines)
3384         $w_load conf -state normal
3385         $w_line conf -state normal
3386         $w_file conf -state normal
3387         while {[gets $fd line] >= 0} {
3388                 regsub "\r\$" $line {} line
3389                 incr n
3390                 $w_load insert end "\n"
3391                 $w_line insert end "$n\n" linenumber
3392                 $w_file insert end "$line\n"
3393         }
3394         $w_load conf -state disabled
3395         $w_line conf -state disabled
3396         $w_file conf -state disabled
3397         set blame_data($w,total_lines) $n
3398
3399         if {[eof $fd]} {
3400                 close $fd
3401                 blame_incremental_status $w
3402                 set cmd [list git blame -M -C --incremental]
3403                 lappend cmd $commit -- $path
3404                 set fd [open "| $cmd" r]
3405                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3406                 fileevent $fd readable [list read_blame_incremental $fd $w \
3407                         $w_load $w_cmit $w_line $w_file]
3408         }
3409 }
3410
3411 proc read_blame_incremental {fd w w_load w_cmit w_line w_file} {
3412         global blame_status blame_data
3413
3414         if {![winfo exists $w_file]} {
3415                 catch {close $fd}
3416                 return
3417         }
3418
3419         while {[gets $fd line] >= 0} {
3420                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3421                         cmit original_line final_line line_count]} {
3422                         set blame_data($w,commit) $cmit
3423                         set blame_data($w,original_line) $original_line
3424                         set blame_data($w,final_line) $final_line
3425                         set blame_data($w,line_count) $line_count
3426
3427                         if {[catch {set g $blame_data($w,$cmit,order)}]} {
3428                                 $w_line tag conf g$cmit
3429                                 $w_file tag conf g$cmit
3430                                 $w_line tag raise in_sel
3431                                 $w_file tag raise in_sel
3432                                 $w_file tag raise sel
3433                                 set blame_data($w,$cmit,order) $blame_data($w,commit_count)
3434                                 incr blame_data($w,commit_count)
3435                                 lappend blame_data($w,commit_list) $cmit
3436                         }
3437                 } elseif {[string match {filename *} $line]} {
3438                         set file [string range $line 9 end]
3439                         set n $blame_data($w,line_count)
3440                         set lno $blame_data($w,final_line)
3441                         set cmit $blame_data($w,commit)
3442
3443                         while {$n > 0} {
3444                                 if {[catch {set g g$blame_data($w,line$lno,commit)}]} {
3445                                         $w_load tag add annotated $lno.0 "$lno.0 lineend + 1c"
3446                                 } else {
3447                                         $w_line tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3448                                         $w_file tag remove g$g $lno.0 "$lno.0 lineend + 1c"
3449                                 }
3450
3451                                 set blame_data($w,line$lno,commit) $cmit
3452                                 set blame_data($w,line$lno,file) $file
3453                                 $w_line tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3454                                 $w_file tag add g$cmit $lno.0 "$lno.0 lineend + 1c"
3455
3456                                 if {$blame_data($w,highlight_line) == -1} {
3457                                         if {[lindex [$w_file yview] 0] == 0} {
3458                                                 $w_file see $lno.0
3459                                                 blame_showcommit $w $w_cmit $w_line $w_file $lno
3460                                         }
3461                                 } elseif {$blame_data($w,highlight_line) == $lno} {
3462                                         blame_showcommit $w $w_cmit $w_line $w_file $lno
3463                                 }
3464
3465                                 incr n -1
3466                                 incr lno
3467                                 incr blame_data($w,blame_lines)
3468                         }
3469
3470                         set hc $blame_data($w,highlight_commit)
3471                         if {$hc ne {}
3472                                 && [expr {$blame_data($w,$hc,order) + 1}]
3473                                         == $blame_data($w,$cmit,order)} {
3474                                 blame_showcommit $w $w_cmit $w_line $w_file \
3475                                         $blame_data($w,highlight_line)
3476                         }
3477                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3478                         set blame_data($w,$blame_data($w,commit),$header) $data
3479                 }
3480         }
3481
3482         if {[eof $fd]} {
3483                 close $fd
3484                 set blame_status($w) {Annotation complete.}
3485         } else {
3486                 blame_incremental_status $w
3487         }
3488 }
3489
3490 proc blame_incremental_status {w} {
3491         global blame_status blame_data
3492
3493         set blame_status($w) [format \
3494                 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3495                 $blame_data($w,blame_lines) \
3496                 $blame_data($w,total_lines) \
3497                 [expr {100 * $blame_data($w,blame_lines)
3498                         / $blame_data($w,total_lines)}]]
3499 }
3500
3501 proc blame_click {w w_cmit w_line w_file cur_w pos} {
3502         set lno [lindex [split [$cur_w index $pos] .] 0]
3503         if {$lno eq {}} return
3504
3505         $w_line tag remove in_sel 0.0 end
3506         $w_file tag remove in_sel 0.0 end
3507         $w_line tag add in_sel $lno.0 "$lno.0 + 1 line"
3508         $w_file tag add in_sel $lno.0 "$lno.0 + 1 line"
3509
3510         blame_showcommit $w $w_cmit $w_line $w_file $lno
3511 }
3512
3513 set blame_colors {
3514         #ff4040
3515         #ff40ff
3516         #4040ff
3517 }
3518
3519 proc blame_showcommit {w w_cmit w_line w_file lno} {
3520         global blame_colors blame_data repo_config
3521
3522         set cmit $blame_data($w,highlight_commit)
3523         if {$cmit ne {}} {
3524                 set idx $blame_data($w,$cmit,order)
3525                 set i 0
3526                 foreach c $blame_colors {
3527                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3528                         $w_line tag conf g$h -background white
3529                         $w_file tag conf g$h -background white
3530                         incr i
3531                 }
3532         }
3533
3534         $w_cmit conf -state normal
3535         $w_cmit delete 0.0 end
3536         if {[catch {set cmit $blame_data($w,line$lno,commit)}]} {
3537                 set cmit {}
3538                 $w_cmit insert end "Loading annotation..."
3539         } else {
3540                 set idx $blame_data($w,$cmit,order)
3541                 set i 0
3542                 foreach c $blame_colors {
3543                         set h [lindex $blame_data($w,commit_list) [expr {$idx - 1 + $i}]]
3544                         $w_line tag conf g$h -background $c
3545                         $w_file tag conf g$h -background $c
3546                         incr i
3547                 }
3548
3549                 if {[catch {set msg $blame_data($w,$cmit,message)}]} {
3550                         set msg {}
3551                         catch {
3552                                 set fd [open "| git cat-file commit $cmit" r]
3553                                 fconfigure $fd -encoding binary -translation lf
3554                                 if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
3555                                         set enc utf-8
3556                                 }
3557                                 while {[gets $fd line] > 0} {
3558                                         if {[string match {encoding *} $line]} {
3559                                                 set enc [string tolower [string range $line 9 end]]
3560                                         }
3561                                 }
3562                                 fconfigure $fd -encoding $enc
3563                                 set msg [string trim [read $fd]]
3564                                 close $fd
3565                         }
3566                         set blame_data($w,$cmit,message) $msg
3567                 }
3568
3569                 set author_name {}
3570                 set author_email {}
3571                 set author_time {}
3572                 catch {set author_name $blame_data($w,$cmit,author)}
3573                 catch {set author_email $blame_data($w,$cmit,author-mail)}
3574                 catch {set author_time [clock format $blame_data($w,$cmit,author-time)]}
3575
3576                 set committer_name {}
3577                 set committer_email {}
3578                 set committer_time {}
3579                 catch {set committer_name $blame_data($w,$cmit,committer)}
3580                 catch {set committer_email $blame_data($w,$cmit,committer-mail)}
3581                 catch {set committer_time [clock format $blame_data($w,$cmit,committer-time)]}
3582
3583                 $w_cmit insert end "commit $cmit\n"
3584                 $w_cmit insert end "Author: $author_name $author_email $author_time\n"
3585                 $w_cmit insert end "Committer: $committer_name $committer_email $committer_time\n"
3586                 $w_cmit insert end "Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3587                 $w_cmit insert end "\n"
3588                 $w_cmit insert end $msg
3589         }
3590         $w_cmit conf -state disabled
3591
3592         set blame_data($w,highlight_line) $lno
3593         set blame_data($w,highlight_commit) $cmit
3594 }
3595
3596 proc blame_copycommit {w i pos} {
3597         global blame_data
3598         set lno [lindex [split [$i index $pos] .] 0]
3599         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3600                 clipboard clear
3601                 clipboard append \
3602                         -format STRING \
3603                         -type STRING \
3604                         -- $commit
3605         }
3606 }
3607
3608 ######################################################################
3609 ##
3610 ## icons
3611
3612 set filemask {
3613 #define mask_width 14
3614 #define mask_height 15
3615 static unsigned char mask_bits[] = {
3616    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3617    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3618    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3619 }
3620
3621 image create bitmap file_plain -background white -foreground black -data {
3622 #define plain_width 14
3623 #define plain_height 15
3624 static unsigned char plain_bits[] = {
3625    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3626    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3627    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3628 } -maskdata $filemask
3629
3630 image create bitmap file_mod -background white -foreground blue -data {
3631 #define mod_width 14
3632 #define mod_height 15
3633 static unsigned char mod_bits[] = {
3634    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3635    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3636    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3637 } -maskdata $filemask
3638
3639 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3640 #define file_fulltick_width 14
3641 #define file_fulltick_height 15
3642 static unsigned char file_fulltick_bits[] = {
3643    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3644    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3645    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3646 } -maskdata $filemask
3647
3648 image create bitmap file_parttick -background white -foreground "#005050" -data {
3649 #define parttick_width 14
3650 #define parttick_height 15
3651 static unsigned char parttick_bits[] = {
3652    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3653    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3654    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3655 } -maskdata $filemask
3656
3657 image create bitmap file_question -background white -foreground black -data {
3658 #define file_question_width 14
3659 #define file_question_height 15
3660 static unsigned char file_question_bits[] = {
3661    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3662    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3663    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3664 } -maskdata $filemask
3665
3666 image create bitmap file_removed -background white -foreground red -data {
3667 #define file_removed_width 14
3668 #define file_removed_height 15
3669 static unsigned char file_removed_bits[] = {
3670    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3671    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3672    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3673 } -maskdata $filemask
3674
3675 image create bitmap file_merge -background white -foreground blue -data {
3676 #define file_merge_width 14
3677 #define file_merge_height 15
3678 static unsigned char file_merge_bits[] = {
3679    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3680    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3681    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3682 } -maskdata $filemask
3683
3684 set file_dir_data {
3685 #define file_width 18
3686 #define file_height 18
3687 static unsigned char file_bits[] = {
3688   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3689   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3690   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3691   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3692   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3693 }
3694 image create bitmap file_dir -background white -foreground blue \
3695         -data $file_dir_data -maskdata $file_dir_data
3696 unset file_dir_data
3697
3698 set file_uplevel_data {
3699 #define up_width 15
3700 #define up_height 15
3701 static unsigned char up_bits[] = {
3702   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3703   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3704   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3705 }
3706 image create bitmap file_uplevel -background white -foreground red \
3707         -data $file_uplevel_data -maskdata $file_uplevel_data
3708 unset file_uplevel_data
3709
3710 set ui_index .vpane.files.index.list
3711 set ui_workdir .vpane.files.workdir.list
3712
3713 set all_icons(_$ui_index)   file_plain
3714 set all_icons(A$ui_index)   file_fulltick
3715 set all_icons(M$ui_index)   file_fulltick
3716 set all_icons(D$ui_index)   file_removed
3717 set all_icons(U$ui_index)   file_merge
3718
3719 set all_icons(_$ui_workdir) file_plain
3720 set all_icons(M$ui_workdir) file_mod
3721 set all_icons(D$ui_workdir) file_question
3722 set all_icons(U$ui_workdir) file_merge
3723 set all_icons(O$ui_workdir) file_plain
3724
3725 set max_status_desc 0
3726 foreach i {
3727                 {__ "Unmodified"}
3728
3729                 {_M "Modified, not staged"}
3730                 {M_ "Staged for commit"}
3731                 {MM "Portions staged for commit"}
3732                 {MD "Staged for commit, missing"}
3733
3734                 {_O "Untracked, not staged"}
3735                 {A_ "Staged for commit"}
3736                 {AM "Portions staged for commit"}
3737                 {AD "Staged for commit, missing"}
3738
3739                 {_D "Missing"}
3740                 {D_ "Staged for removal"}
3741                 {DO "Staged for removal, still present"}
3742
3743                 {U_ "Requires merge resolution"}
3744                 {UU "Requires merge resolution"}
3745                 {UM "Requires merge resolution"}
3746                 {UD "Requires merge resolution"}
3747         } {
3748         if {$max_status_desc < [string length [lindex $i 1]]} {
3749                 set max_status_desc [string length [lindex $i 1]]
3750         }
3751         set all_descs([lindex $i 0]) [lindex $i 1]
3752 }
3753 unset i
3754
3755 ######################################################################
3756 ##
3757 ## util
3758
3759 proc bind_button3 {w cmd} {
3760         bind $w <Any-Button-3> $cmd
3761         if {[is_MacOSX]} {
3762                 bind $w <Control-Button-1> $cmd
3763         }
3764 }
3765
3766 proc scrollbar2many {list mode args} {
3767         foreach w $list {eval $w $mode $args}
3768 }
3769
3770 proc many2scrollbar {list mode sb top bottom} {
3771         $sb set $top $bottom
3772         foreach w $list {$w $mode moveto $top}
3773 }
3774
3775 proc incr_font_size {font {amt 1}} {
3776         set sz [font configure $font -size]
3777         incr sz $amt
3778         font configure $font -size $sz
3779         font configure ${font}bold -size $sz
3780 }
3781
3782 proc hook_failed_popup {hook msg} {
3783         set w .hookfail
3784         toplevel $w
3785
3786         frame $w.m
3787         label $w.m.l1 -text "$hook hook failed:" \
3788                 -anchor w \
3789                 -justify left \
3790                 -font font_uibold
3791         text $w.m.t \
3792                 -background white -borderwidth 1 \
3793                 -relief sunken \
3794                 -width 80 -height 10 \
3795                 -font font_diff \
3796                 -yscrollcommand [list $w.m.sby set]
3797         label $w.m.l2 \
3798                 -text {You must correct the above errors before committing.} \
3799                 -anchor w \
3800                 -justify left \
3801                 -font font_uibold
3802         scrollbar $w.m.sby -command [list $w.m.t yview]
3803         pack $w.m.l1 -side top -fill x
3804         pack $w.m.l2 -side bottom -fill x
3805         pack $w.m.sby -side right -fill y
3806         pack $w.m.t -side left -fill both -expand 1
3807         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3808
3809         $w.m.t insert 1.0 $msg
3810         $w.m.t conf -state disabled
3811
3812         button $w.ok -text OK \
3813                 -width 15 \
3814                 -font font_ui \
3815                 -command "destroy $w"
3816         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3817
3818         bind $w <Visibility> "grab $w; focus $w"
3819         bind $w <Key-Return> "destroy $w"
3820         wm title $w "[appname] ([reponame]): error"
3821         tkwait window $w
3822 }
3823
3824 set next_console_id 0
3825
3826 proc new_console {short_title long_title} {
3827         global next_console_id console_data
3828         set w .console[incr next_console_id]
3829         set console_data($w) [list $short_title $long_title]
3830         return [console_init $w]
3831 }
3832
3833 proc console_init {w} {
3834         global console_cr console_data M1B
3835
3836         set console_cr($w) 1.0
3837         toplevel $w
3838         frame $w.m
3839         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3840                 -anchor w \
3841                 -justify left \
3842                 -font font_uibold
3843         text $w.m.t \
3844                 -background white -borderwidth 1 \
3845                 -relief sunken \
3846                 -width 80 -height 10 \
3847                 -font font_diff \
3848                 -state disabled \
3849                 -yscrollcommand [list $w.m.sby set]
3850         label $w.m.s -text {Working... please wait...} \
3851                 -anchor w \
3852                 -justify left \
3853                 -font font_uibold
3854         scrollbar $w.m.sby -command [list $w.m.t yview]
3855         pack $w.m.l1 -side top -fill x
3856         pack $w.m.s -side bottom -fill x
3857         pack $w.m.sby -side right -fill y
3858         pack $w.m.t -side left -fill both -expand 1
3859         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3860
3861         menu $w.ctxm -tearoff 0
3862         $w.ctxm add command -label "Copy" \
3863                 -font font_ui \
3864                 -command "tk_textCopy $w.m.t"
3865         $w.ctxm add command -label "Select All" \
3866                 -font font_ui \
3867                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3868         $w.ctxm add command -label "Copy All" \
3869                 -font font_ui \
3870                 -command "
3871                         $w.m.t tag add sel 0.0 end
3872                         tk_textCopy $w.m.t
3873                         $w.m.t tag remove sel 0.0 end
3874                 "
3875
3876         button $w.ok -text {Close} \
3877                 -font font_ui \
3878                 -state disabled \
3879                 -command "destroy $w"
3880         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3881
3882         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3883         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3884         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3885         bind $w <Visibility> "focus $w"
3886         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3887         return $w
3888 }
3889
3890 proc console_exec {w cmd after} {
3891         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3892         #    But most users need that so we have to relogin. :-(
3893         #
3894         if {[is_Cygwin]} {
3895                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3896         }
3897
3898         # -- Tcl won't let us redirect both stdout and stderr to
3899         #    the same pipe.  So pass it through cat...
3900         #
3901         set cmd [concat | $cmd |& cat]
3902
3903         set fd_f [open $cmd r]
3904         fconfigure $fd_f -blocking 0 -translation binary
3905         fileevent $fd_f readable [list console_read $w $fd_f $after]
3906 }
3907
3908 proc console_read {w fd after} {
3909         global console_cr
3910
3911         set buf [read $fd]
3912         if {$buf ne {}} {
3913                 if {![winfo exists $w]} {console_init $w}
3914                 $w.m.t conf -state normal
3915                 set c 0
3916                 set n [string length $buf]
3917                 while {$c < $n} {
3918                         set cr [string first "\r" $buf $c]
3919                         set lf [string first "\n" $buf $c]
3920                         if {$cr < 0} {set cr [expr {$n + 1}]}
3921                         if {$lf < 0} {set lf [expr {$n + 1}]}
3922
3923                         if {$lf < $cr} {
3924                                 $w.m.t insert end [string range $buf $c $lf]
3925                                 set console_cr($w) [$w.m.t index {end -1c}]
3926                                 set c $lf
3927                                 incr c
3928                         } else {
3929                                 $w.m.t delete $console_cr($w) end
3930                                 $w.m.t insert end "\n"
3931                                 $w.m.t insert end [string range $buf $c $cr]
3932                                 set c $cr
3933                                 incr c
3934                         }
3935                 }
3936                 $w.m.t conf -state disabled
3937                 $w.m.t see end
3938         }
3939
3940         fconfigure $fd -blocking 1
3941         if {[eof $fd]} {
3942                 if {[catch {close $fd}]} {
3943                         set ok 0
3944                 } else {
3945                         set ok 1
3946                 }
3947                 uplevel #0 $after $w $ok
3948                 return
3949         }
3950         fconfigure $fd -blocking 0
3951 }
3952
3953 proc console_chain {cmdlist w {ok 1}} {
3954         if {$ok} {
3955                 if {[llength $cmdlist] == 0} {
3956                         console_done $w $ok
3957                         return
3958                 }
3959
3960                 set cmd [lindex $cmdlist 0]
3961                 set cmdlist [lrange $cmdlist 1 end]
3962
3963                 if {[lindex $cmd 0] eq {console_exec}} {
3964                         console_exec $w \
3965                                 [lindex $cmd 1] \
3966                                 [list console_chain $cmdlist]
3967                 } else {
3968                         uplevel #0 $cmd $cmdlist $w $ok
3969                 }
3970         } else {
3971                 console_done $w $ok
3972         }
3973 }
3974
3975 proc console_done {args} {
3976         global console_cr console_data
3977
3978         switch -- [llength $args] {
3979         2 {
3980                 set w [lindex $args 0]
3981                 set ok [lindex $args 1]
3982         }
3983         3 {
3984                 set w [lindex $args 1]
3985                 set ok [lindex $args 2]
3986         }
3987         default {
3988                 error "wrong number of args: console_done ?ignored? w ok"
3989         }
3990         }
3991
3992         if {$ok} {
3993                 if {[winfo exists $w]} {
3994                         $w.m.s conf -background green -text {Success}
3995                         $w.ok conf -state normal
3996                 }
3997         } else {
3998                 if {![winfo exists $w]} {
3999                         console_init $w
4000                 }
4001                 $w.m.s conf -background red -text {Error: Command Failed}
4002                 $w.ok conf -state normal
4003         }
4004
4005         array unset console_cr $w
4006         array unset console_data $w
4007 }
4008
4009 ######################################################################
4010 ##
4011 ## ui commands
4012
4013 set starting_gitk_msg {Starting gitk... please wait...}
4014
4015 proc do_gitk {revs} {
4016         global env ui_status_value starting_gitk_msg
4017
4018         # -- On Windows gitk is severly broken, and right now it seems like
4019         #    nobody cares about fixing it.  The only known workaround is to
4020         #    always delete ~/.gitk before starting the program.
4021         #
4022         if {[is_Windows]} {
4023                 catch {file delete [file join $env(HOME) .gitk]}
4024         }
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 {exec 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 "[exec 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,} [exec 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