git.oblomov.eu Git - git/blob - 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 repo-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 repo-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 repo-config --global --unset $name}
 206                         } else {
 207                                 regsub -all "\[{}\]" $value {"} value
 208                                 exec git repo-config --global $name $value
 209                         }
 210                         set global_config($name) $value
 211                         if {$value eq $repo_config($name)} {
 212                                 catch {exec git repo-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 repo-config --unset $name}
 223                         } else {
 224                                 regsub -all "\[{}\]" $value {"} value
 225                                 exec git repo-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         set texts [list]
3239
3240         label $w.path -text "$commit:$path" \
3241                 -anchor w \
3242                 -justify left \
3243                 -borderwidth 1 \
3244                 -relief sunken \
3245                 -font font_uibold
3246         pack $w.path -side top -fill x
3247
3248         set hbg #e2effa
3249         frame $w.out
3250         label $w.out.commit_l -text Commit \
3251                 -relief solid \
3252                 -borderwidth 1 \
3253                 -background $hbg \
3254                 -font font_uibold
3255         text $w.out.commit_t \
3256                 -background white -borderwidth 0 \
3257                 -state disabled \
3258                 -wrap none \
3259                 -height 40 \
3260                 -width 9 \
3261                 -font font_diff
3262         lappend texts $w.out.commit_t
3263
3264         label $w.out.author_l -text Author \
3265                 -relief solid \
3266                 -borderwidth 1 \
3267                 -background $hbg \
3268                 -font font_uibold
3269         text $w.out.author_t \
3270                 -background white -borderwidth 0 \
3271                 -state disabled \
3272                 -wrap none \
3273                 -height 40 \
3274                 -width 20 \
3275                 -font font_diff
3276         lappend texts $w.out.author_t
3277
3278         label $w.out.date_l -text Date \
3279                 -relief solid \
3280                 -borderwidth 1 \
3281                 -background $hbg \
3282                 -font font_uibold
3283         text $w.out.date_t \
3284                 -background white -borderwidth 0 \
3285                 -state disabled \
3286                 -wrap none \
3287                 -height 40 \
3288                 -width [string length "yyyy-mm-dd hh:mm:ss"] \
3289                 -font font_diff
3290         lappend texts $w.out.date_t
3291
3292         label $w.out.filename_l -text Filename \
3293                 -relief solid \
3294                 -borderwidth 1 \
3295                 -background $hbg \
3296                 -font font_uibold
3297         text $w.out.filename_t \
3298                 -background white -borderwidth 0 \
3299                 -state disabled \
3300                 -wrap none \
3301                 -height 40 \
3302                 -width 20 \
3303                 -font font_diff
3304         lappend texts $w.out.filename_t
3305
3306         label $w.out.origlinenumber_l -text {Orig Line} \
3307                 -relief solid \
3308                 -borderwidth 1 \
3309                 -background $hbg \
3310                 -font font_uibold
3311         text $w.out.origlinenumber_t \
3312                 -background white -borderwidth 0 \
3313                 -state disabled \
3314                 -wrap none \
3315                 -height 40 \
3316                 -width 5 \
3317                 -font font_diff
3318         $w.out.origlinenumber_t tag conf linenumber -justify right
3319         lappend texts $w.out.origlinenumber_t
3320
3321         label $w.out.linenumber_l -text {Curr Line} \
3322                 -relief solid \
3323                 -borderwidth 1 \
3324                 -background $hbg \
3325                 -font font_uibold
3326         text $w.out.linenumber_t \
3327                 -background white -borderwidth 0 \
3328                 -state disabled \
3329                 -wrap none \
3330                 -height 40 \
3331                 -width 5 \
3332                 -font font_diff
3333         $w.out.linenumber_t tag conf linenumber -justify right
3334         lappend texts $w.out.linenumber_t
3335
3336         label $w.out.file_l -text {File Content} \
3337                 -relief solid \
3338                 -borderwidth 1 \
3339                 -background $hbg \
3340                 -font font_uibold
3341         text $w.out.file_t \
3342                 -background white -borderwidth 0 \
3343                 -state disabled \
3344                 -wrap none \
3345                 -height 40 \
3346                 -width 80 \
3347                 -xscrollcommand [list $w.out.sbx set] \
3348                 -font font_diff
3349         lappend texts $w.out.file_t
3350
3351         scrollbar $w.out.sbx -orient h -command [list $w.out.file_t xview]
3352         scrollbar $w.out.sby -orient v \
3353                 -command [list scrollbar2many $texts yview]
3354         set labels [list]
3355         foreach i $texts {
3356                 regsub {_t$} $i _l l
3357                 lappend labels $l
3358         }
3359         set file_col [expr {[llength $texts] - 1}]
3360         eval grid $labels -sticky we
3361         eval grid $texts $w.out.sby -sticky nsew
3362         grid conf $w.out.sbx -column $file_col -sticky we
3363         grid columnconfigure $w.out $file_col -weight 1
3364         grid rowconfigure $w.out 1 -weight 1
3365         pack $w.out -fill both -expand 1
3366
3367         label $w.status -textvariable blame_status($w) \
3368                 -anchor w \
3369                 -justify left \
3370                 -borderwidth 1 \
3371                 -relief sunken \
3372                 -font font_ui
3373         pack $w.status -side bottom -fill x
3374
3375         menu $w.ctxm -tearoff 0
3376         $w.ctxm add command -label "Copy Commit" \
3377                 -font font_ui \
3378                 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3379
3380         foreach i $texts {
3381                 $i tag conf in_sel \
3382                         -background [$i cget -foreground] \
3383                         -foreground [$i cget -background]
3384                 $i conf -yscrollcommand \
3385                         [list many2scrollbar $texts yview $w.out.sby]
3386                 bind $i <Button-1> "blame_highlight $i @%x,%y $texts;break"
3387                 bind_button3 $i "
3388                         set cursorX %x
3389                         set cursorY %y
3390                         set cursorW %W
3391                         tk_popup $w.ctxm %X %Y
3392                 "
3393         }
3394
3395         set blame_data($w,colors) {}
3396
3397         bind $tl <Visibility> "focus $tl"
3398         bind $tl <Destroy> "
3399                 array unset blame_status {$w}
3400                 array unset blame_data $w,*
3401         "
3402         wm title $tl "[appname] ([reponame]): File Viewer"
3403
3404         set blame_data($w,total_lines) 0
3405         set cmd [list git cat-file blob "$commit:$path"]
3406         set fd [open "| $cmd" r]
3407         fconfigure $fd -blocking 0 -translation lf -encoding binary
3408         fileevent $fd readable [list read_blame_catfile \
3409                 $fd $w $commit $path \
3410                 $texts $w.out.linenumber_t $w.out.file_t]
3411 }
3412
3413 proc read_blame_catfile {fd w commit path texts w_lno w_file} {
3414         global blame_status blame_data
3415
3416         if {![winfo exists $w_file]} {
3417                 catch {close $fd}
3418                 return
3419         }
3420
3421         set n $blame_data($w,total_lines)
3422         foreach i $texts {$i conf -state normal}
3423         while {[gets $fd line] >= 0} {
3424                 regsub "\r\$" $line {} line
3425                 incr n
3426                 $w_lno insert end $n linenumber
3427                 $w_file insert end $line
3428                 foreach i $texts {$i insert end "\n"}
3429         }
3430         foreach i $texts {$i conf -state disabled}
3431         set blame_data($w,total_lines) $n
3432
3433         if {[eof $fd]} {
3434                 close $fd
3435                 set blame_status($w) {Loading annotations...}
3436                 set cmd [list git blame -M -C --incremental]
3437                 lappend cmd $commit -- $path
3438                 set fd [open "| $cmd" r]
3439                 fconfigure $fd -blocking 0 -translation lf -encoding binary
3440                 set handler [list read_blame_incremental $fd $w]
3441                 append handler " $texts"
3442                 fileevent $fd readable $handler
3443         }
3444 }
3445
3446 proc read_blame_incremental {fd w
3447         w_commit w_author w_date w_filename w_olno
3448         w_lno w_file} {
3449         global blame_status blame_data
3450
3451         if {![winfo exists $w_commit]} {
3452                 catch {close $fd}
3453                 return
3454         }
3455
3456         set all [list \
3457                 $w_commit \
3458                 $w_author \
3459                 $w_date \
3460                 $w_filename \
3461                 $w_olno \
3462                 $w_lno \
3463                 $w_file]
3464
3465         $w_commit conf -state normal
3466         $w_author conf -state normal
3467         $w_date conf -state normal
3468         $w_filename conf -state normal
3469         $w_olno conf -state normal
3470
3471         while {[gets $fd line] >= 0} {
3472                 if {[regexp {^([a-z0-9]{40}) (\d+) (\d+) (\d+)$} $line line \
3473                         cmit original_line final_line line_count]} {
3474                         set blame_data($w,commit) $cmit
3475                         set blame_data($w,original_line) $original_line
3476                         set blame_data($w,final_line) $final_line
3477                         set blame_data($w,line_count) $line_count
3478
3479                         if {[catch {set g $blame_data($w,$cmit,seen)}]} {
3480                                 if {$blame_data($w,colors) eq {}} {
3481                                         set blame_data($w,colors) {
3482                                                 yellow
3483                                                 red
3484                                                 pink
3485                                                 orange
3486                                                 green
3487                                                 grey
3488                                         }
3489                                 }
3490                                 set c [lindex $blame_data($w,colors) 0]
3491                                 set blame_data($w,colors) \
3492                                         [lrange $blame_data($w,colors) 1 end]
3493                                 foreach t $all {
3494                                         $t tag conf g$cmit -background $c
3495                                 }
3496                         } else {
3497                                 set blame_data($w,$cmit,seen) 1
3498                         }
3499                 } elseif {[string match {filename *} $line]} {
3500                         set n $blame_data($w,line_count)
3501                         set lno $blame_data($w,final_line)
3502                         set ol $blame_data($w,original_line)
3503                         set file [string range $line 9 end]
3504                         set cmit $blame_data($w,commit)
3505                         set abbrev [string range $cmit 0 8]
3506
3507                         if {[catch {set author $blame_data($w,$cmit,author)} err]} {
3508                                 set author {}
3509                         }
3510
3511                         if {[catch {set atime $blame_data($w,$cmit,author-time)}]} {
3512                                 set atime {}
3513                         } else {
3514                                 set atime [clock format $atime -format {%Y-%m-%d %T}]
3515                         }
3516
3517                         while {$n > 0} {
3518                                 if {![catch {set g g$blame_data($w,line$lno,commit)}]} {
3519                                         foreach t $all {
3520                                                 $t tag remove $g $lno.0 "$lno.0 lineend + 1c"
3521                                         }
3522                                 }
3523
3524                                 foreach t [list \
3525                                         $w_commit \
3526                                         $w_author \
3527                                         $w_date \
3528                                         $w_filename \
3529                                         $w_olno] {
3530                                         $t delete $lno.0 "$lno.0 lineend"
3531                                 }
3532
3533                                 $w_commit insert $lno.0 $abbrev
3534                                 $w_author insert $lno.0 $author
3535                                 $w_date insert $lno.0 $atime
3536                                 $w_filename insert $lno.0 $file
3537                                 $w_olno insert $lno.0 $ol linenumber
3538
3539                                 set g g$cmit
3540                                 foreach t $all {
3541                                         $t tag add $g $lno.0 "$lno.0 lineend + 1c"
3542                                 }
3543
3544                                 set blame_data($w,line$lno,commit) $cmit
3545
3546                                 incr n -1
3547                                 incr lno
3548                                 incr ol
3549                         }
3550                 } elseif {[regexp {^([a-z-]+) (.*)$} $line line header data]} {
3551                         set blame_data($w,$blame_data($w,commit),$header) $data
3552                 }
3553         }
3554
3555         $w_commit conf -state disabled
3556         $w_author conf -state disabled
3557         $w_date conf -state disabled
3558         $w_filename conf -state disabled
3559         $w_olno conf -state disabled
3560
3561         if {[eof $fd]} {
3562                 close $fd
3563                 set blame_status($w) {Annotation complete.}
3564         }
3565 }
3566
3567 proc blame_highlight {w pos args} {
3568         set lno [lindex [split [$w index $pos] .] 0]
3569         foreach i $args {
3570                 $i tag remove in_sel 0.0 end
3571         }
3572         if {$lno eq {}} return
3573         foreach i $args {
3574                 $i tag add in_sel $lno.0 "$lno.0 + 1 line"
3575         }
3576 }
3577
3578 proc blame_copycommit {w i pos} {
3579         global blame_data
3580         set lno [lindex [split [$i index $pos] .] 0]
3581         if {![catch {set commit $blame_data($w,line$lno,commit)}]} {
3582                 clipboard clear
3583                 clipboard append \
3584                         -format STRING \
3585                         -type STRING \
3586                         -- $commit
3587         }
3588 }
3589
3590 ######################################################################
3591 ##
3592 ## icons
3593
3594 set filemask {
3595 #define mask_width 14
3596 #define mask_height 15
3597 static unsigned char mask_bits[] = {
3598    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3599    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3600    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3601 }
3602
3603 image create bitmap file_plain -background white -foreground black -data {
3604 #define plain_width 14
3605 #define plain_height 15
3606 static unsigned char plain_bits[] = {
3607    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3608    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3609    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3610 } -maskdata $filemask
3611
3612 image create bitmap file_mod -background white -foreground blue -data {
3613 #define mod_width 14
3614 #define mod_height 15
3615 static unsigned char mod_bits[] = {
3616    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3617    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3618    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3619 } -maskdata $filemask
3620
3621 image create bitmap file_fulltick -background white -foreground "#007000" -data {
3622 #define file_fulltick_width 14
3623 #define file_fulltick_height 15
3624 static unsigned char file_fulltick_bits[] = {
3625    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3626    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3627    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3628 } -maskdata $filemask
3629
3630 image create bitmap file_parttick -background white -foreground "#005050" -data {
3631 #define parttick_width 14
3632 #define parttick_height 15
3633 static unsigned char parttick_bits[] = {
3634    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3635    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3636    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3637 } -maskdata $filemask
3638
3639 image create bitmap file_question -background white -foreground black -data {
3640 #define file_question_width 14
3641 #define file_question_height 15
3642 static unsigned char file_question_bits[] = {
3643    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3644    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3645    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3646 } -maskdata $filemask
3647
3648 image create bitmap file_removed -background white -foreground red -data {
3649 #define file_removed_width 14
3650 #define file_removed_height 15
3651 static unsigned char file_removed_bits[] = {
3652    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3653    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3654    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3655 } -maskdata $filemask
3656
3657 image create bitmap file_merge -background white -foreground blue -data {
3658 #define file_merge_width 14
3659 #define file_merge_height 15
3660 static unsigned char file_merge_bits[] = {
3661    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3662    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3663    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3664 } -maskdata $filemask
3665
3666 set file_dir_data {
3667 #define file_width 18
3668 #define file_height 18
3669 static unsigned char file_bits[] = {
3670   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3671   0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3672   0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3673   0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3674   0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3675 }
3676 image create bitmap file_dir -background white -foreground blue \
3677         -data $file_dir_data -maskdata $file_dir_data
3678 unset file_dir_data
3679
3680 set file_uplevel_data {
3681 #define up_width 15
3682 #define up_height 15
3683 static unsigned char up_bits[] = {
3684   0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3685   0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3686   0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3687 }
3688 image create bitmap file_uplevel -background white -foreground red \
3689         -data $file_uplevel_data -maskdata $file_uplevel_data
3690 unset file_uplevel_data
3691
3692 set ui_index .vpane.files.index.list
3693 set ui_workdir .vpane.files.workdir.list
3694
3695 set all_icons(_$ui_index)   file_plain
3696 set all_icons(A$ui_index)   file_fulltick
3697 set all_icons(M$ui_index)   file_fulltick
3698 set all_icons(D$ui_index)   file_removed
3699 set all_icons(U$ui_index)   file_merge
3700
3701 set all_icons(_$ui_workdir) file_plain
3702 set all_icons(M$ui_workdir) file_mod
3703 set all_icons(D$ui_workdir) file_question
3704 set all_icons(U$ui_workdir) file_merge
3705 set all_icons(O$ui_workdir) file_plain
3706
3707 set max_status_desc 0
3708 foreach i {
3709                 {__ "Unmodified"}
3710
3711                 {_M "Modified, not staged"}
3712                 {M_ "Staged for commit"}
3713                 {MM "Portions staged for commit"}
3714                 {MD "Staged for commit, missing"}
3715
3716                 {_O "Untracked, not staged"}
3717                 {A_ "Staged for commit"}
3718                 {AM "Portions staged for commit"}
3719                 {AD "Staged for commit, missing"}
3720
3721                 {_D "Missing"}
3722                 {D_ "Staged for removal"}
3723                 {DO "Staged for removal, still present"}
3724
3725                 {U_ "Requires merge resolution"}
3726                 {UU "Requires merge resolution"}
3727                 {UM "Requires merge resolution"}
3728                 {UD "Requires merge resolution"}
3729         } {
3730         if {$max_status_desc < [string length [lindex $i 1]]} {
3731                 set max_status_desc [string length [lindex $i 1]]
3732         }
3733         set all_descs([lindex $i 0]) [lindex $i 1]
3734 }
3735 unset i
3736
3737 ######################################################################
3738 ##
3739 ## util
3740
3741 proc bind_button3 {w cmd} {
3742         bind $w <Any-Button-3> $cmd
3743         if {[is_MacOSX]} {
3744                 bind $w <Control-Button-1> $cmd
3745         }
3746 }
3747
3748 proc scrollbar2many {list mode args} {
3749         foreach w $list {eval $w $mode $args}
3750 }
3751
3752 proc many2scrollbar {list mode sb top bottom} {
3753         $sb set $top $bottom
3754         foreach w $list {$w $mode moveto $top}
3755 }
3756
3757 proc incr_font_size {font {amt 1}} {
3758         set sz [font configure $font -size]
3759         incr sz $amt
3760         font configure $font -size $sz
3761         font configure ${font}bold -size $sz
3762 }
3763
3764 proc hook_failed_popup {hook msg} {
3765         set w .hookfail
3766         toplevel $w
3767
3768         frame $w.m
3769         label $w.m.l1 -text "$hook hook failed:" \
3770                 -anchor w \
3771                 -justify left \
3772                 -font font_uibold
3773         text $w.m.t \
3774                 -background white -borderwidth 1 \
3775                 -relief sunken \
3776                 -width 80 -height 10 \
3777                 -font font_diff \
3778                 -yscrollcommand [list $w.m.sby set]
3779         label $w.m.l2 \
3780                 -text {You must correct the above errors before committing.} \
3781                 -anchor w \
3782                 -justify left \
3783                 -font font_uibold
3784         scrollbar $w.m.sby -command [list $w.m.t yview]
3785         pack $w.m.l1 -side top -fill x
3786         pack $w.m.l2 -side bottom -fill x
3787         pack $w.m.sby -side right -fill y
3788         pack $w.m.t -side left -fill both -expand 1
3789         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3790
3791         $w.m.t insert 1.0 $msg
3792         $w.m.t conf -state disabled
3793
3794         button $w.ok -text OK \
3795                 -width 15 \
3796                 -font font_ui \
3797                 -command "destroy $w"
3798         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3799
3800         bind $w <Visibility> "grab $w; focus $w"
3801         bind $w <Key-Return> "destroy $w"
3802         wm title $w "[appname] ([reponame]): error"
3803         tkwait window $w
3804 }
3805
3806 set next_console_id 0
3807
3808 proc new_console {short_title long_title} {
3809         global next_console_id console_data
3810         set w .console[incr next_console_id]
3811         set console_data($w) [list $short_title $long_title]
3812         return [console_init $w]
3813 }
3814
3815 proc console_init {w} {
3816         global console_cr console_data M1B
3817
3818         set console_cr($w) 1.0
3819         toplevel $w
3820         frame $w.m
3821         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
3822                 -anchor w \
3823                 -justify left \
3824                 -font font_uibold
3825         text $w.m.t \
3826                 -background white -borderwidth 1 \
3827                 -relief sunken \
3828                 -width 80 -height 10 \
3829                 -font font_diff \
3830                 -state disabled \
3831                 -yscrollcommand [list $w.m.sby set]
3832         label $w.m.s -text {Working... please wait...} \
3833                 -anchor w \
3834                 -justify left \
3835                 -font font_uibold
3836         scrollbar $w.m.sby -command [list $w.m.t yview]
3837         pack $w.m.l1 -side top -fill x
3838         pack $w.m.s -side bottom -fill x
3839         pack $w.m.sby -side right -fill y
3840         pack $w.m.t -side left -fill both -expand 1
3841         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
3842
3843         menu $w.ctxm -tearoff 0
3844         $w.ctxm add command -label "Copy" \
3845                 -font font_ui \
3846                 -command "tk_textCopy $w.m.t"
3847         $w.ctxm add command -label "Select All" \
3848                 -font font_ui \
3849                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3850         $w.ctxm add command -label "Copy All" \
3851                 -font font_ui \
3852                 -command "
3853                         $w.m.t tag add sel 0.0 end
3854                         tk_textCopy $w.m.t
3855                         $w.m.t tag remove sel 0.0 end
3856                 "
3857
3858         button $w.ok -text {Close} \
3859                 -font font_ui \
3860                 -state disabled \
3861                 -command "destroy $w"
3862         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
3863
3864         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
3865         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3866         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3867         bind $w <Visibility> "focus $w"
3868         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3869         return $w
3870 }
3871
3872 proc console_exec {w cmd after} {
3873         # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3874         #    But most users need that so we have to relogin. :-(
3875         #
3876         if {[is_Cygwin]} {
3877                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
3878         }
3879
3880         # -- Tcl won't let us redirect both stdout and stderr to
3881         #    the same pipe.  So pass it through cat...
3882         #
3883         set cmd [concat | $cmd |& cat]
3884
3885         set fd_f [open $cmd r]
3886         fconfigure $fd_f -blocking 0 -translation binary
3887         fileevent $fd_f readable [list console_read $w $fd_f $after]
3888 }
3889
3890 proc console_read {w fd after} {
3891         global console_cr
3892
3893         set buf [read $fd]
3894         if {$buf ne {}} {
3895                 if {![winfo exists $w]} {console_init $w}
3896                 $w.m.t conf -state normal
3897                 set c 0
3898                 set n [string length $buf]
3899                 while {$c < $n} {
3900                         set cr [string first "\r" $buf $c]
3901                         set lf [string first "\n" $buf $c]
3902                         if {$cr < 0} {set cr [expr {$n + 1}]}
3903                         if {$lf < 0} {set lf [expr {$n + 1}]}
3904
3905                         if {$lf < $cr} {
3906                                 $w.m.t insert end [string range $buf $c $lf]
3907                                 set console_cr($w) [$w.m.t index {end -1c}]
3908                                 set c $lf
3909                                 incr c
3910                         } else {
3911                                 $w.m.t delete $console_cr($w) end
3912                                 $w.m.t insert end "\n"
3913                                 $w.m.t insert end [string range $buf $c $cr]
3914                                 set c $cr
3915                                 incr c
3916                         }
3917                 }
3918                 $w.m.t conf -state disabled
3919                 $w.m.t see end
3920         }
3921
3922         fconfigure $fd -blocking 1
3923         if {[eof $fd]} {
3924                 if {[catch {close $fd}]} {
3925                         set ok 0
3926                 } else {
3927                         set ok 1
3928                 }
3929                 uplevel #0 $after $w $ok
3930                 return
3931         }
3932         fconfigure $fd -blocking 0
3933 }
3934
3935 proc console_chain {cmdlist w {ok 1}} {
3936         if {$ok} {
3937                 if {[llength $cmdlist] == 0} {
3938                         console_done $w $ok
3939                         return
3940                 }
3941
3942                 set cmd [lindex $cmdlist 0]
3943                 set cmdlist [lrange $cmdlist 1 end]
3944
3945                 if {[lindex $cmd 0] eq {console_exec}} {
3946                         console_exec $w \
3947                                 [lindex $cmd 1] \
3948                                 [list console_chain $cmdlist]
3949                 } else {
3950                         uplevel #0 $cmd $cmdlist $w $ok
3951                 }
3952         } else {
3953                 console_done $w $ok
3954         }
3955 }
3956
3957 proc console_done {args} {
3958         global console_cr console_data
3959
3960         switch -- [llength $args] {
3961         2 {
3962                 set w [lindex $args 0]
3963                 set ok [lindex $args 1]
3964         }
3965         3 {
3966                 set w [lindex $args 1]
3967                 set ok [lindex $args 2]
3968         }
3969         default {
3970                 error "wrong number of args: console_done ?ignored? w ok"
3971         }
3972         }
3973
3974         if {$ok} {
3975                 if {[winfo exists $w]} {
3976                         $w.m.s conf -background green -text {Success}
3977                         $w.ok conf -state normal
3978                 }
3979         } else {
3980                 if {![winfo exists $w]} {
3981                         console_init $w
3982                 }
3983                 $w.m.s conf -background red -text {Error: Command Failed}
3984                 $w.ok conf -state normal
3985         }
3986
3987         array unset console_cr $w
3988         array unset console_data $w
3989 }
3990
3991 ######################################################################
3992 ##
3993 ## ui commands
3994
3995 set starting_gitk_msg {Starting gitk... please wait...}
3996
3997 proc do_gitk {revs} {
3998         global env ui_status_value starting_gitk_msg
3999
4000         # -- On Windows gitk is severly broken, and right now it seems like
4001         #    nobody cares about fixing it.  The only known workaround is to
4002         #    always delete ~/.gitk before starting the program.
4003         #
4004         if {[is_Windows]} {
4005                 catch {file delete [file join $env(HOME) .gitk]}
4006         }
4007
4008         # -- Always start gitk through whatever we were loaded with.  This
4009         #    lets us bypass using shell process on Windows systems.
4010         #
4011         set cmd [info nameofexecutable]
4012         lappend cmd [gitexec gitk]
4013         if {$revs ne {}} {
4014                 append cmd { }
4015                 append cmd $revs
4016         }
4017
4018         if {[catch {eval exec $cmd &} err]} {
4019                 error_popup "Failed to start gitk:\n\n$err"
4020         } else {
4021                 set ui_status_value $starting_gitk_msg
4022                 after 10000 {
4023                         if {$ui_status_value eq $starting_gitk_msg} {
4024                                 set ui_status_value {Ready.}
4025                         }
4026                 }
4027         }
4028 }
4029
4030 proc do_stats {} {
4031         set fd [open "| git count-objects -v" r]
4032         while {[gets $fd line] > 0} {
4033                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
4034                         set stats($name) $value
4035                 }
4036         }
4037         close $fd
4038
4039         set packed_sz 0
4040         foreach p [glob -directory [gitdir objects pack] \
4041                 -type f \
4042                 -nocomplain -- *] {
4043                 incr packed_sz [file size $p]
4044         }
4045         if {$packed_sz > 0} {
4046                 set stats(size-pack) [expr {$packed_sz / 1024}]
4047         }
4048
4049         set w .stats_view
4050         toplevel $w
4051         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4052
4053         label $w.header -text {Database Statistics} \
4054                 -font font_uibold
4055         pack $w.header -side top -fill x
4056
4057         frame $w.buttons -border 1
4058         button $w.buttons.close -text Close \
4059                 -font font_ui \
4060                 -command [list destroy $w]
4061         button $w.buttons.gc -text {Compress Database} \
4062                 -font font_ui \
4063                 -command "destroy $w;do_gc"
4064         pack $w.buttons.close -side right
4065         pack $w.buttons.gc -side left
4066         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4067
4068         frame $w.stat -borderwidth 1 -relief solid
4069         foreach s {
4070                 {count           {Number of loose objects}}
4071                 {size            {Disk space used by loose objects} { KiB}}
4072                 {in-pack         {Number of packed objects}}
4073                 {packs           {Number of packs}}
4074                 {size-pack       {Disk space used by packed objects} { KiB}}
4075                 {prune-packable  {Packed objects waiting for pruning}}
4076                 {garbage         {Garbage files}}
4077                 } {
4078                 set name [lindex $s 0]
4079                 set label [lindex $s 1]
4080                 if {[catch {set value $stats($name)}]} continue
4081                 if {[llength $s] > 2} {
4082                         set value "$value[lindex $s 2]"
4083                 }
4084
4085                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
4086                 label $w.stat.v_$name -text $value -anchor w -font font_ui
4087                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
4088         }
4089         pack $w.stat -pady 10 -padx 10
4090
4091         bind $w <Visibility> "grab $w; focus $w"
4092         bind $w <Key-Escape> [list destroy $w]
4093         bind $w <Key-Return> [list destroy $w]
4094         wm title $w "[appname] ([reponame]): Database Statistics"
4095         tkwait window $w
4096 }
4097
4098 proc do_gc {} {
4099         set w [new_console {gc} {Compressing the object database}]
4100         console_chain {
4101                 {console_exec {git pack-refs --prune}}
4102                 {console_exec {git reflog expire --all}}
4103                 {console_exec {git repack -a -d -l}}
4104                 {console_exec {git rerere gc}}
4105         } $w
4106 }
4107
4108 proc do_fsck_objects {} {
4109         set w [new_console {fsck-objects} \
4110                 {Verifying the object database with fsck-objects}]
4111         set cmd [list git fsck-objects]
4112         lappend cmd --full
4113         lappend cmd --cache
4114         lappend cmd --strict
4115         console_exec $w $cmd console_done
4116 }
4117
4118 set is_quitting 0
4119
4120 proc do_quit {} {
4121         global ui_comm is_quitting repo_config commit_type
4122
4123         if {$is_quitting} return
4124         set is_quitting 1
4125
4126         if {[winfo exists $ui_comm]} {
4127                 # -- Stash our current commit buffer.
4128                 #
4129                 set save [gitdir GITGUI_MSG]
4130                 set msg [string trim [$ui_comm get 0.0 end]]
4131                 regsub -all -line {[ \r\t]+$} $msg {} msg
4132                 if {(![string match amend* $commit_type]
4133                         || [$ui_comm edit modified])
4134                         && $msg ne {}} {
4135                         catch {
4136                                 set fd [open $save w]
4137                                 puts -nonewline $fd $msg
4138                                 close $fd
4139                         }
4140                 } else {
4141                         catch {file delete $save}
4142                 }
4143
4144                 # -- Stash our current window geometry into this repository.
4145                 #
4146                 set cfg_geometry [list]
4147                 lappend cfg_geometry [wm geometry .]
4148                 lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
4149                 lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
4150                 if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
4151                         set rc_geometry {}
4152                 }
4153                 if {$cfg_geometry ne $rc_geometry} {
4154                         catch {exec git repo-config gui.geometry $cfg_geometry}
4155                 }
4156         }
4157
4158         destroy .
4159 }
4160
4161 proc do_rescan {} {
4162         rescan {set ui_status_value {Ready.}}
4163 }
4164
4165 proc unstage_helper {txt paths} {
4166         global file_states current_diff_path
4167
4168         if {![lock_index begin-update]} return
4169
4170         set pathList [list]
4171         set after {}
4172         foreach path $paths {
4173                 switch -glob -- [lindex $file_states($path) 0] {
4174                 A? -
4175                 M? -
4176                 D? {
4177                         lappend pathList $path
4178                         if {$path eq $current_diff_path} {
4179                                 set after {reshow_diff;}
4180                         }
4181                 }
4182                 }
4183         }
4184         if {$pathList eq {}} {
4185                 unlock_index
4186         } else {
4187                 update_indexinfo \
4188                         $txt \
4189                         $pathList \
4190                         [concat $after {set ui_status_value {Ready.}}]
4191         }
4192 }
4193
4194 proc do_unstage_selection {} {
4195         global current_diff_path selected_paths
4196
4197         if {[array size selected_paths] > 0} {
4198                 unstage_helper \
4199                         {Unstaging selected files from commit} \
4200                         [array names selected_paths]
4201         } elseif {$current_diff_path ne {}} {
4202                 unstage_helper \
4203                         "Unstaging [short_path $current_diff_path] from commit" \
4204                         [list $current_diff_path]
4205         }
4206 }
4207
4208 proc add_helper {txt paths} {
4209         global file_states current_diff_path
4210
4211         if {![lock_index begin-update]} return
4212
4213         set pathList [list]
4214         set after {}
4215         foreach path $paths {
4216                 switch -glob -- [lindex $file_states($path) 0] {
4217                 _O -
4218                 ?M -
4219                 ?D -
4220                 U? {
4221                         lappend pathList $path
4222                         if {$path eq $current_diff_path} {
4223                                 set after {reshow_diff;}
4224                         }
4225                 }
4226                 }
4227         }
4228         if {$pathList eq {}} {
4229                 unlock_index
4230         } else {
4231                 update_index \
4232                         $txt \
4233                         $pathList \
4234                         [concat $after {set ui_status_value {Ready to commit.}}]
4235         }
4236 }
4237
4238 proc do_add_selection {} {
4239         global current_diff_path selected_paths
4240
4241         if {[array size selected_paths] > 0} {
4242                 add_helper \
4243                         {Adding selected files} \
4244                         [array names selected_paths]
4245         } elseif {$current_diff_path ne {}} {
4246                 add_helper \
4247                         "Adding [short_path $current_diff_path]" \
4248                         [list $current_diff_path]
4249         }
4250 }
4251
4252 proc do_add_all {} {
4253         global file_states
4254
4255         set paths [list]
4256         foreach path [array names file_states] {
4257                 switch -glob -- [lindex $file_states($path) 0] {
4258                 U? {continue}
4259                 ?M -
4260                 ?D {lappend paths $path}
4261                 }
4262         }
4263         add_helper {Adding all changed files} $paths
4264 }
4265
4266 proc revert_helper {txt paths} {
4267         global file_states current_diff_path
4268
4269         if {![lock_index begin-update]} return
4270
4271         set pathList [list]
4272         set after {}
4273         foreach path $paths {
4274                 switch -glob -- [lindex $file_states($path) 0] {
4275                 U? {continue}
4276                 ?M -
4277                 ?D {
4278                         lappend pathList $path
4279                         if {$path eq $current_diff_path} {
4280                                 set after {reshow_diff;}
4281                         }
4282                 }
4283                 }
4284         }
4285
4286         set n [llength $pathList]
4287         if {$n == 0} {
4288                 unlock_index
4289                 return
4290         } elseif {$n == 1} {
4291                 set s "[short_path [lindex $pathList]]"
4292         } else {
4293                 set s "these $n files"
4294         }
4295
4296         set reply [tk_dialog \
4297                 .confirm_revert \
4298                 "[appname] ([reponame])" \
4299                 "Revert changes in $s?
4300
4301 Any unadded changes will be permanently lost by the revert." \
4302                 question \
4303                 1 \
4304                 {Do Nothing} \
4305                 {Revert Changes} \
4306                 ]
4307         if {$reply == 1} {
4308                 checkout_index \
4309                         $txt \
4310                         $pathList \
4311                         [concat $after {set ui_status_value {Ready.}}]
4312         } else {
4313                 unlock_index
4314         }
4315 }
4316
4317 proc do_revert_selection {} {
4318         global current_diff_path selected_paths
4319
4320         if {[array size selected_paths] > 0} {
4321                 revert_helper \
4322                         {Reverting selected files} \
4323                         [array names selected_paths]
4324         } elseif {$current_diff_path ne {}} {
4325                 revert_helper \
4326                         "Reverting [short_path $current_diff_path]" \
4327                         [list $current_diff_path]
4328         }
4329 }
4330
4331 proc do_signoff {} {
4332         global ui_comm
4333
4334         set me [committer_ident]
4335         if {$me eq {}} return
4336
4337         set sob "Signed-off-by: $me"
4338         set last [$ui_comm get {end -1c linestart} {end -1c}]
4339         if {$last ne $sob} {
4340                 $ui_comm edit separator
4341                 if {$last ne {}
4342                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
4343                         $ui_comm insert end "\n"
4344                 }
4345                 $ui_comm insert end "\n$sob"
4346                 $ui_comm edit separator
4347                 $ui_comm see end
4348         }
4349 }
4350
4351 proc do_select_commit_type {} {
4352         global commit_type selected_commit_type
4353
4354         if {$selected_commit_type eq {new}
4355                 && [string match amend* $commit_type]} {
4356                 create_new_commit
4357         } elseif {$selected_commit_type eq {amend}
4358                 && ![string match amend* $commit_type]} {
4359                 load_last_commit
4360
4361                 # The amend request was rejected...
4362                 #
4363                 if {![string match amend* $commit_type]} {
4364                         set selected_commit_type new
4365                 }
4366         }
4367 }
4368
4369 proc do_commit {} {
4370         commit_tree
4371 }
4372
4373 proc do_about {} {
4374         global appvers copyright
4375         global tcl_patchLevel tk_patchLevel
4376
4377         set w .about_dialog
4378         toplevel $w
4379         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4380
4381         label $w.header -text "About [appname]" \
4382                 -font font_uibold
4383         pack $w.header -side top -fill x
4384
4385         frame $w.buttons
4386         button $w.buttons.close -text {Close} \
4387                 -font font_ui \
4388                 -command [list destroy $w]
4389         pack $w.buttons.close -side right
4390         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4391
4392         label $w.desc \
4393                 -text "[appname] - a commit creation tool for Git.
4394 $copyright" \
4395                 -padx 5 -pady 5 \
4396                 -justify left \
4397                 -anchor w \
4398                 -borderwidth 1 \
4399                 -relief solid \
4400                 -font font_ui
4401         pack $w.desc -side top -fill x -padx 5 -pady 5
4402
4403         set v {}
4404         append v "[appname] version $appvers\n"
4405         append v "[exec git version]\n"
4406         append v "\n"
4407         if {$tcl_patchLevel eq $tk_patchLevel} {
4408                 append v "Tcl/Tk version $tcl_patchLevel"
4409         } else {
4410                 append v "Tcl version $tcl_patchLevel"
4411                 append v ", Tk version $tk_patchLevel"
4412         }
4413
4414         label $w.vers \
4415                 -text $v \
4416                 -padx 5 -pady 5 \
4417                 -justify left \
4418                 -anchor w \
4419                 -borderwidth 1 \
4420                 -relief solid \
4421                 -font font_ui
4422         pack $w.vers -side top -fill x -padx 5 -pady 5
4423
4424         menu $w.ctxm -tearoff 0
4425         $w.ctxm add command \
4426                 -label {Copy} \
4427                 -font font_ui \
4428                 -command "
4429                 clipboard clear
4430                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4431         "
4432
4433         bind $w <Visibility> "grab $w; focus $w"
4434         bind $w <Key-Escape> "destroy $w"
4435         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4436         wm title $w "About [appname]"
4437         tkwait window $w
4438 }
4439
4440 proc do_options {} {
4441         global repo_config global_config font_descs
4442         global repo_config_new global_config_new
4443
4444         array unset repo_config_new
4445         array unset global_config_new
4446         foreach name [array names repo_config] {
4447                 set repo_config_new($name) $repo_config($name)
4448         }
4449         load_config 1
4450         foreach name [array names repo_config] {
4451                 switch -- $name {
4452                 gui.diffcontext {continue}
4453                 }
4454                 set repo_config_new($name) $repo_config($name)
4455         }
4456         foreach name [array names global_config] {
4457                 set global_config_new($name) $global_config($name)
4458         }
4459
4460         set w .options_editor
4461         toplevel $w
4462         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
4463
4464         label $w.header -text "[appname] Options" \
4465                 -font font_uibold
4466         pack $w.header -side top -fill x
4467
4468         frame $w.buttons
4469         button $w.buttons.restore -text {Restore Defaults} \
4470                 -font font_ui \
4471                 -command do_restore_defaults
4472         pack $w.buttons.restore -side left
4473         button $w.buttons.save -text Save \
4474                 -font font_ui \
4475                 -command [list do_save_config $w]
4476         pack $w.buttons.save -side right
4477         button $w.buttons.cancel -text {Cancel} \
4478                 -font font_ui \
4479                 -command [list destroy $w]
4480         pack $w.buttons.cancel -side right -padx 5
4481         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
4482
4483         labelframe $w.repo -text "[reponame] Repository" \
4484                 -font font_ui
4485         labelframe $w.global -text {Global (All Repositories)} \
4486                 -font font_ui
4487         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
4488         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
4489
4490         set optid 0
4491         foreach option {
4492                 {t user.name {User Name}}
4493                 {t user.email {Email Address}}
4494
4495                 {b merge.summary {Summarize Merge Commits}}
4496                 {i-1..5 merge.verbosity {Merge Verbosity}}
4497
4498                 {b gui.trustmtime  {Trust File Modification Timestamps}}
4499                 {i-1..99 gui.diffcontext {Number of Diff Context Lines}}
4500                 {t gui.newbranchtemplate {New Branch Name Template}}
4501                 } {
4502                 set type [lindex $option 0]
4503                 set name [lindex $option 1]
4504                 set text [lindex $option 2]
4505                 incr optid
4506                 foreach f {repo global} {
4507                         switch -glob -- $type {
4508                         b {
4509                                 checkbutton $w.$f.$optid -text $text \
4510                                         -variable ${f}_config_new($name) \
4511                                         -onvalue true \
4512                                         -offvalue false \
4513                                         -font font_ui
4514                                 pack $w.$f.$optid -side top -anchor w
4515                         }
4516                         i-* {
4517                                 regexp -- {-(\d+)\.\.(\d+)$} $type _junk min max
4518                                 frame $w.$f.$optid
4519                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4520                                 pack $w.$f.$optid.l -side left -anchor w -fill x
4521                                 spinbox $w.$f.$optid.v \
4522                                         -textvariable ${f}_config_new($name) \
4523                                         -from $min \
4524                                         -to $max \
4525                                         -increment 1 \
4526                                         -width [expr {1 + [string length $max]}] \
4527                                         -font font_ui
4528                                 bind $w.$f.$optid.v <FocusIn> {%W selection range 0 end}
4529                                 pack $w.$f.$optid.v -side right -anchor e -padx 5
4530                                 pack $w.$f.$optid -side top -anchor w -fill x
4531                         }
4532                         t {
4533                                 frame $w.$f.$optid
4534                                 label $w.$f.$optid.l -text "$text:" -font font_ui
4535                                 entry $w.$f.$optid.v \
4536                                         -borderwidth 1 \
4537                                         -relief sunken \
4538                                         -width 20 \
4539                                         -textvariable ${f}_config_new($name) \
4540                                         -font font_ui
4541                                 pack $w.$f.$optid.l -side left -anchor w
4542                                 pack $w.$f.$optid.v -side left -anchor w \
4543                                         -fill x -expand 1 \
4544                                         -padx 5
4545                                 pack $w.$f.$optid -side top -anchor w -fill x
4546                         }
4547                         }
4548                 }
4549         }
4550
4551         set all_fonts [lsort [font families]]
4552         foreach option $font_descs {
4553                 set name [lindex $option 0]
4554                 set font [lindex $option 1]
4555                 set text [lindex $option 2]
4556
4557                 set global_config_new(gui.$font^^family) \
4558                         [font configure $font -family]
4559                 set global_config_new(gui.$font^^size) \
4560                         [font configure $font -size]
4561
4562                 frame $w.global.$name
4563                 label $w.global.$name.l -text "$text:" -font font_ui
4564                 pack $w.global.$name.l -side left -anchor w -fill x
4565                 eval tk_optionMenu $w.global.$name.family \
4566                         global_config_new(gui.$font^^family) \
4567                         $all_fonts
4568                 spinbox $w.global.$name.size \
4569                         -textvariable global_config_new(gui.$font^^size) \
4570                         -from 2 -to 80 -increment 1 \
4571                         -width 3 \
4572                         -font font_ui
4573                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
4574                 pack $w.global.$name.size -side right -anchor e
4575                 pack $w.global.$name.family -side right -anchor e
4576                 pack $w.global.$name -side top -anchor w -fill x
4577         }
4578
4579         bind $w <Visibility> "grab $w; focus $w"
4580         bind $w <Key-Escape> "destroy $w"
4581         wm title $w "[appname] ([reponame]): Options"
4582         tkwait window $w
4583 }
4584
4585 proc do_restore_defaults {} {
4586         global font_descs default_config repo_config
4587         global repo_config_new global_config_new
4588
4589         foreach name [array names default_config] {
4590                 set repo_config_new($name) $default_config($name)
4591                 set global_config_new($name) $default_config($name)
4592         }
4593
4594         foreach option $font_descs {
4595                 set name [lindex $option 0]
4596                 set repo_config(gui.$name) $default_config(gui.$name)
4597         }
4598         apply_config
4599
4600         foreach option $font_descs {
4601                 set name [lindex $option 0]
4602                 set font [lindex $option 1]
4603                 set global_config_new(gui.$font^^family) \
4604                         [font configure $font -family]
4605                 set global_config_new(gui.$font^^size) \
4606                         [font configure $font -size]
4607         }
4608 }
4609
4610 proc do_save_config {w} {
4611         if {[catch {save_config} err]} {
4612                 error_popup "Failed to completely save options:\n\n$err"
4613         }
4614         reshow_diff
4615         destroy $w
4616 }
4617
4618 proc do_windows_shortcut {} {
4619         global argv0
4620
4621         set fn [tk_getSaveFile \
4622                 -parent . \
4623                 -title "[appname] ([reponame]): Create Desktop Icon" \
4624                 -initialfile "Git [reponame].bat"]
4625         if {$fn != {}} {
4626                 if {[catch {
4627                                 set fd [open $fn w]
4628                                 puts $fd "@ECHO Entering [reponame]"
4629                                 puts $fd "@ECHO Starting git-gui... please wait..."
4630                                 puts $fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4631                                 puts $fd "@SET GIT_DIR=[file normalize [gitdir]]"
4632                                 puts -nonewline $fd "@\"[info nameofexecutable]\""
4633                                 puts $fd " \"[file normalize $argv0]\""
4634                                 close $fd
4635                         } err]} {
4636                         error_popup "Cannot write script:\n\n$err"
4637                 }
4638         }
4639 }
4640
4641 proc do_cygwin_shortcut {} {
4642         global argv0
4643
4644         if {[catch {
4645                 set desktop [exec cygpath \
4646                         --windows \
4647                         --absolute \
4648                         --long-name \
4649                         --desktop]
4650                 }]} {
4651                         set desktop .
4652         }
4653         set fn [tk_getSaveFile \
4654                 -parent . \
4655                 -title "[appname] ([reponame]): Create Desktop Icon" \
4656                 -initialdir $desktop \
4657                 -initialfile "Git [reponame].bat"]
4658         if {$fn != {}} {
4659                 if {[catch {
4660                                 set fd [open $fn w]
4661                                 set sh [exec cygpath \
4662                                         --windows \
4663                                         --absolute \
4664                                         /bin/sh]
4665                                 set me [exec cygpath \
4666                                         --unix \
4667                                         --absolute \
4668                                         $argv0]
4669                                 set gd [exec cygpath \
4670                                         --unix \
4671                                         --absolute \
4672                                         [gitdir]]
4673                                 set gw [exec cygpath \
4674                                         --windows \
4675                                         --absolute \
4676                                         [file dirname [gitdir]]]
4677                                 regsub -all ' $me "'\\''" me
4678                                 regsub -all ' $gd "'\\''" gd
4679                                 puts $fd "@ECHO Entering $gw"
4680                                 puts $fd "@ECHO Starting git-gui... please wait..."
4681                                 puts -nonewline $fd "@\"$sh\" --login -c \""
4682                                 puts -nonewline $fd "GIT_DIR='$gd'"
4683                                 puts -nonewline $fd " '$me'"
4684                                 puts $fd "&\""
4685                                 close $fd
4686                         } err]} {
4687                         error_popup "Cannot write script:\n\n$err"
4688                 }
4689         }
4690 }
4691
4692 proc do_macosx_app {} {
4693         global argv0 env
4694
4695         set fn [tk_getSaveFile \
4696                 -parent . \
4697                 -title "[appname] ([reponame]): Create Desktop Icon" \
4698                 -initialdir [file join $env(HOME) Desktop] \
4699                 -initialfile "Git [reponame].app"]
4700         if {$fn != {}} {
4701                 if {[catch {
4702                                 set Contents [file join $fn Contents]
4703                                 set MacOS [file join $Contents MacOS]
4704                                 set exe [file join $MacOS git-gui]
4705
4706                                 file mkdir $MacOS
4707
4708                                 set fd [open [file join $Contents Info.plist] w]
4709                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4710 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4711 <plist version="1.0">
4712 <dict>
4713         <key>CFBundleDevelopmentRegion</key>
4714         <string>English</string>
4715         <key>CFBundleExecutable</key>
4716         <string>git-gui</string>
4717         <key>CFBundleIdentifier</key>
4718         <string>org.spearce.git-gui</string>
4719         <key>CFBundleInfoDictionaryVersion</key>
4720         <string>6.0</string>
4721         <key>CFBundlePackageType</key>
4722         <string>APPL</string>
4723         <key>CFBundleSignature</key>
4724         <string>????</string>
4725         <key>CFBundleVersion</key>
4726         <string>1.0</string>
4727         <key>NSPrincipalClass</key>
4728         <string>NSApplication</string>
4729 </dict>
4730 </plist>}
4731                                 close $fd
4732
4733                                 set fd [open $exe w]
4734                                 set gd [file normalize [gitdir]]
4735                                 set ep [file normalize [gitexec]]
4736                                 regsub -all ' $gd "'\\''" gd
4737                                 regsub -all ' $ep "'\\''" ep
4738                                 puts $fd "#!/bin/sh"
4739                                 foreach name [array names env] {
4740                                         if {[string match GIT_* $name]} {
4741                                                 regsub -all ' $env($name) "'\\''" v
4742                                                 puts $fd "export $name='$v'"
4743                                         }
4744                                 }
4745                                 puts $fd "export PATH='$ep':\$PATH"
4746                                 puts $fd "export GIT_DIR='$gd'"
4747                                 puts $fd "exec [file normalize $argv0]"
4748                                 close $fd
4749
4750                                 file attributes $exe -permissions u+x,g+x,o+x
4751                         } err]} {
4752                         error_popup "Cannot write icon:\n\n$err"
4753                 }
4754         }
4755 }
4756
4757 proc toggle_or_diff {w x y} {
4758         global file_states file_lists current_diff_path ui_index ui_workdir
4759         global last_clicked selected_paths
4760
4761         set pos [split [$w index @$x,$y] .]
4762         set lno [lindex $pos 0]
4763         set col [lindex $pos 1]
4764         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4765         if {$path eq {}} {
4766                 set last_clicked {}
4767                 return
4768         }
4769
4770         set last_clicked [list $w $lno]
4771         array unset selected_paths
4772         $ui_index tag remove in_sel 0.0 end
4773         $ui_workdir tag remove in_sel 0.0 end
4774
4775         if {$col == 0} {
4776                 if {$current_diff_path eq $path} {
4777                         set after {reshow_diff;}
4778                 } else {
4779                         set after {}
4780                 }
4781                 if {$w eq $ui_index} {
4782                         update_indexinfo \
4783                                 "Unstaging [short_path $path] from commit" \
4784                                 [list $path] \
4785                                 [concat $after {set ui_status_value {Ready.}}]
4786                 } elseif {$w eq $ui_workdir} {
4787                         update_index \
4788                                 "Adding [short_path $path]" \
4789                                 [list $path] \
4790                                 [concat $after {set ui_status_value {Ready.}}]
4791                 }
4792         } else {
4793                 show_diff $path $w $lno
4794         }
4795 }
4796
4797 proc add_one_to_selection {w x y} {
4798         global file_lists last_clicked selected_paths
4799
4800         set lno [lindex [split [$w index @$x,$y] .] 0]
4801         set path [lindex $file_lists($w) [expr {$lno - 1}]]
4802         if {$path eq {}} {
4803                 set last_clicked {}
4804                 return
4805         }
4806
4807         if {$last_clicked ne {}
4808                 && [lindex $last_clicked 0] ne $w} {
4809                 array unset selected_paths
4810                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4811         }
4812
4813         set last_clicked [list $w $lno]
4814         if {[catch {set in_sel $selected_paths($path)}]} {
4815                 set in_sel 0
4816         }
4817         if {$in_sel} {
4818                 unset selected_paths($path)
4819                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4820         } else {
4821                 set selected_paths($path) 1
4822                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4823         }
4824 }
4825
4826 proc add_range_to_selection {w x y} {
4827         global file_lists last_clicked selected_paths
4828
4829         if {[lindex $last_clicked 0] ne $w} {
4830                 toggle_or_diff $w $x $y
4831                 return
4832         }
4833
4834         set lno [lindex [split [$w index @$x,$y] .] 0]
4835         set lc [lindex $last_clicked 1]
4836         if {$lc < $lno} {
4837                 set begin $lc
4838                 set end $lno
4839         } else {
4840                 set begin $lno
4841                 set end $lc
4842         }
4843
4844         foreach path [lrange $file_lists($w) \
4845                 [expr {$begin - 1}] \
4846                 [expr {$end - 1}]] {
4847                 set selected_paths($path) 1
4848         }
4849         $w tag add in_sel $begin.0 [expr {$end + 1}].0
4850 }
4851
4852 ######################################################################
4853 ##
4854 ## config defaults
4855
4856 set cursor_ptr arrow
4857 font create font_diff -family Courier -size 10
4858 font create font_ui
4859 catch {
4860         label .dummy
4861         eval font configure font_ui [font actual [.dummy cget -font]]
4862         destroy .dummy
4863 }
4864
4865 font create font_uibold
4866 font create font_diffbold
4867
4868 if {[is_Windows]} {
4869         set M1B Control
4870         set M1T Ctrl
4871 } elseif {[is_MacOSX]} {
4872         set M1B M1
4873         set M1T Cmd
4874 } else {
4875         set M1B M1
4876         set M1T M1
4877 }
4878
4879 proc apply_config {} {
4880         global repo_config font_descs
4881
4882         foreach option $font_descs {
4883                 set name [lindex $option 0]
4884                 set font [lindex $option 1]
4885                 if {[catch {
4886                         foreach {cn cv} $repo_config(gui.$name) {
4887                                 font configure $font $cn $cv
4888                         }
4889                         } err]} {
4890                         error_popup "Invalid font specified in gui.$name:\n\n$err"
4891                 }
4892                 foreach {cn cv} [font configure $font] {
4893                         font configure ${font}bold $cn $cv
4894                 }
4895                 font configure ${font}bold -weight bold
4896         }
4897 }
4898
4899 set default_config(merge.summary) false
4900 set default_config(merge.verbosity) 2
4901 set default_config(user.name) {}
4902 set default_config(user.email) {}
4903
4904 set default_config(gui.trustmtime) false
4905 set default_config(gui.diffcontext) 5
4906 set default_config(gui.newbranchtemplate) {}
4907 set default_config(gui.fontui) [font configure font_ui]
4908 set default_config(gui.fontdiff) [font configure font_diff]
4909 set font_descs {
4910         {fontui   font_ui   {Main Font}}
4911         {fontdiff font_diff {Diff/Console Font}}
4912 }
4913 load_config 0
4914 apply_config
4915
4916 ######################################################################
4917 ##
4918 ## feature option selection
4919
4920 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
4921         unset _junk
4922 } else {
4923         set subcommand gui
4924 }
4925 if {$subcommand eq {gui.sh}} {
4926         set subcommand gui
4927 }
4928 if {$subcommand eq {gui} && [llength $argv] > 0} {
4929         set subcommand [lindex $argv 0]
4930         set argv [lrange $argv 1 end]
4931 }
4932
4933 enable_option multicommit
4934 enable_option branch
4935 enable_option transport
4936
4937 switch -- $subcommand {
4938 blame {
4939         disable_option multicommit
4940         disable_option branch
4941         disable_option transport
4942 }
4943 citool {
4944         enable_option singlecommit
4945
4946         disable_option multicommit
4947         disable_option branch
4948         disable_option transport
4949 }
4950 }
4951
4952 ######################################################################
4953 ##
4954 ## ui construction
4955
4956 set ui_comm {}
4957
4958 # -- Menu Bar
4959 #
4960 menu .mbar -tearoff 0
4961 .mbar add cascade -label Repository -menu .mbar.repository
4962 .mbar add cascade -label Edit -menu .mbar.edit
4963 if {[is_enabled branch]} {
4964         .mbar add cascade -label Branch -menu .mbar.branch
4965 }
4966 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
4967         .mbar add cascade -label Commit -menu .mbar.commit
4968 }
4969 if {[is_enabled transport]} {
4970         .mbar add cascade -label Merge -menu .mbar.merge
4971         .mbar add cascade -label Fetch -menu .mbar.fetch
4972         .mbar add cascade -label Push -menu .mbar.push
4973 }
4974 . configure -menu .mbar
4975
4976 # -- Repository Menu
4977 #
4978 menu .mbar.repository
4979
4980 .mbar.repository add command \
4981         -label {Browse Current Branch} \
4982         -command {new_browser $current_branch} \
4983         -font font_ui
4984 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Browse \$current_branch\" ;#"
4985 .mbar.repository add separator
4986
4987 .mbar.repository add command \
4988         -label {Visualize Current Branch} \
4989         -command {do_gitk $current_branch} \
4990         -font font_ui
4991 trace add variable current_branch write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
4992 .mbar.repository add command \
4993         -label {Visualize All Branches} \
4994         -command {do_gitk --all} \
4995         -font font_ui
4996 .mbar.repository add separator
4997
4998 if {[is_enabled multicommit]} {
4999         .mbar.repository add command -label {Database Statistics} \
5000                 -command do_stats \
5001                 -font font_ui
5002
5003         .mbar.repository add command -label {Compress Database} \
5004                 -command do_gc \
5005                 -font font_ui
5006
5007         .mbar.repository add command -label {Verify Database} \
5008                 -command do_fsck_objects \
5009                 -font font_ui
5010
5011         .mbar.repository add separator
5012
5013         if {[is_Cygwin]} {
5014                 .mbar.repository add command \
5015                         -label {Create Desktop Icon} \
5016                         -command do_cygwin_shortcut \
5017                         -font font_ui
5018         } elseif {[is_Windows]} {
5019                 .mbar.repository add command \
5020                         -label {Create Desktop Icon} \
5021                         -command do_windows_shortcut \
5022                         -font font_ui
5023         } elseif {[is_MacOSX]} {
5024                 .mbar.repository add command \
5025                         -label {Create Desktop Icon} \
5026                         -command do_macosx_app \
5027                         -font font_ui
5028         }
5029 }
5030
5031 .mbar.repository add command -label Quit \
5032         -command do_quit \
5033         -accelerator $M1T-Q \
5034         -font font_ui
5035
5036 # -- Edit Menu
5037 #
5038 menu .mbar.edit
5039 .mbar.edit add command -label Undo \
5040         -command {catch {[focus] edit undo}} \
5041         -accelerator $M1T-Z \
5042         -font font_ui
5043 .mbar.edit add command -label Redo \
5044         -command {catch {[focus] edit redo}} \
5045         -accelerator $M1T-Y \
5046         -font font_ui
5047 .mbar.edit add separator
5048 .mbar.edit add command -label Cut \
5049         -command {catch {tk_textCut [focus]}} \
5050         -accelerator $M1T-X \
5051         -font font_ui
5052 .mbar.edit add command -label Copy \
5053         -command {catch {tk_textCopy [focus]}} \
5054         -accelerator $M1T-C \
5055         -font font_ui
5056 .mbar.edit add command -label Paste \
5057         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
5058         -accelerator $M1T-V \
5059         -font font_ui
5060 .mbar.edit add command -label Delete \
5061         -command {catch {[focus] delete sel.first sel.last}} \
5062         -accelerator Del \
5063         -font font_ui
5064 .mbar.edit add separator
5065 .mbar.edit add command -label {Select All} \
5066         -command {catch {[focus] tag add sel 0.0 end}} \
5067         -accelerator $M1T-A \
5068         -font font_ui
5069
5070 # -- Branch Menu
5071 #
5072 if {[is_enabled branch]} {
5073         menu .mbar.branch
5074
5075         .mbar.branch add command -label {Create...} \
5076                 -command do_create_branch \
5077                 -accelerator $M1T-N \
5078                 -font font_ui
5079         lappend disable_on_lock [list .mbar.branch entryconf \
5080                 [.mbar.branch index last] -state]
5081
5082         .mbar.branch add command -label {Delete...} \
5083                 -command do_delete_branch \
5084                 -font font_ui
5085         lappend disable_on_lock [list .mbar.branch entryconf \
5086                 [.mbar.branch index last] -state]
5087 }
5088
5089 # -- Commit Menu
5090 #
5091 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5092         menu .mbar.commit
5093
5094         .mbar.commit add radiobutton \
5095                 -label {New Commit} \
5096                 -command do_select_commit_type \
5097                 -variable selected_commit_type \
5098                 -value new \
5099                 -font font_ui
5100         lappend disable_on_lock \
5101                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5102
5103         .mbar.commit add radiobutton \
5104                 -label {Amend Last Commit} \
5105                 -command do_select_commit_type \
5106                 -variable selected_commit_type \
5107                 -value amend \
5108                 -font font_ui
5109         lappend disable_on_lock \
5110                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5111
5112         .mbar.commit add separator
5113
5114         .mbar.commit add command -label Rescan \
5115                 -command do_rescan \
5116                 -accelerator F5 \
5117                 -font font_ui
5118         lappend disable_on_lock \
5119                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5120
5121         .mbar.commit add command -label {Add To Commit} \
5122                 -command do_add_selection \
5123                 -font font_ui
5124         lappend disable_on_lock \
5125                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5126
5127         .mbar.commit add command -label {Add Existing To Commit} \
5128                 -command do_add_all \
5129                 -accelerator $M1T-I \
5130                 -font font_ui
5131         lappend disable_on_lock \
5132                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5133
5134         .mbar.commit add command -label {Unstage From Commit} \
5135                 -command do_unstage_selection \
5136                 -font font_ui
5137         lappend disable_on_lock \
5138                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5139
5140         .mbar.commit add command -label {Revert Changes} \
5141                 -command do_revert_selection \
5142                 -font font_ui
5143         lappend disable_on_lock \
5144                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5145
5146         .mbar.commit add separator
5147
5148         .mbar.commit add command -label {Sign Off} \
5149                 -command do_signoff \
5150                 -accelerator $M1T-S \
5151                 -font font_ui
5152
5153         .mbar.commit add command -label Commit \
5154                 -command do_commit \
5155                 -accelerator $M1T-Return \
5156                 -font font_ui
5157         lappend disable_on_lock \
5158                 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5159 }
5160
5161 if {[is_MacOSX]} {
5162         # -- Apple Menu (Mac OS X only)
5163         #
5164         .mbar add cascade -label Apple -menu .mbar.apple
5165         menu .mbar.apple
5166
5167         .mbar.apple add command -label "About [appname]" \
5168                 -command do_about \
5169                 -font font_ui
5170         .mbar.apple add command -label "[appname] Options..." \
5171                 -command do_options \
5172                 -font font_ui
5173 } else {
5174         # -- Edit Menu
5175         #
5176         .mbar.edit add separator
5177         .mbar.edit add command -label {Options...} \
5178                 -command do_options \
5179                 -font font_ui
5180
5181         # -- Tools Menu
5182         #
5183         if {[file exists /usr/local/miga/lib/gui-miga]
5184                 && [file exists .pvcsrc]} {
5185         proc do_miga {} {
5186                 global ui_status_value
5187                 if {![lock_index update]} return
5188                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5189                 set miga_fd [open "|$cmd" r]
5190                 fconfigure $miga_fd -blocking 0
5191                 fileevent $miga_fd readable [list miga_done $miga_fd]
5192                 set ui_status_value {Running miga...}
5193         }
5194         proc miga_done {fd} {
5195                 read $fd 512
5196                 if {[eof $fd]} {
5197                         close $fd
5198                         unlock_index
5199                         rescan [list set ui_status_value {Ready.}]
5200                 }
5201         }
5202         .mbar add cascade -label Tools -menu .mbar.tools
5203         menu .mbar.tools
5204         .mbar.tools add command -label "Migrate" \
5205                 -command do_miga \
5206                 -font font_ui
5207         lappend disable_on_lock \
5208                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5209         }
5210 }
5211
5212 # -- Help Menu
5213 #
5214 .mbar add cascade -label Help -menu .mbar.help
5215 menu .mbar.help
5216
5217 if {![is_MacOSX]} {
5218         .mbar.help add command -label "About [appname]" \
5219                 -command do_about \
5220                 -font font_ui
5221 }
5222
5223 set browser {}
5224 catch {set browser $repo_config(instaweb.browser)}
5225 set doc_path [file dirname [gitexec]]
5226 set doc_path [file join $doc_path Documentation index.html]
5227
5228 if {[is_Cygwin]} {
5229         set doc_path [exec cygpath --windows $doc_path]
5230 }
5231
5232 if {$browser eq {}} {
5233         if {[is_MacOSX]} {
5234                 set browser open
5235         } elseif {[is_Cygwin]} {
5236                 set program_files [file dirname [exec cygpath --windir]]
5237                 set program_files [file join $program_files {Program Files}]
5238                 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5239                 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5240                 if {[file exists $firefox]} {
5241                         set browser $firefox
5242                 } elseif {[file exists $ie]} {
5243                         set browser $ie
5244                 }
5245                 unset program_files firefox ie
5246         }
5247 }
5248
5249 if {[file isfile $doc_path]} {
5250         set doc_url "file:$doc_path"
5251 } else {
5252         set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5253 }
5254
5255 if {$browser ne {}} {
5256         .mbar.help add command -label {Online Documentation} \
5257                 -command [list exec $browser $doc_url &] \
5258                 -font font_ui
5259 }
5260 unset browser doc_path doc_url
5261
5262 # -- Standard bindings
5263 #
5264 bind .   <Destroy> do_quit
5265 bind all <$M1B-Key-q> do_quit
5266 bind all <$M1B-Key-Q> do_quit
5267 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5268 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5269
5270 # -- Not a normal commit type invocation?  Do that instead!
5271 #
5272 switch -- $subcommand {
5273 blame {
5274         if {[llength $argv] != 2} {
5275                 puts stderr "usage: $argv0 blame commit path"
5276                 exit 1
5277         }
5278         set current_branch [lindex $argv 0]
5279         show_blame $current_branch [lindex $argv 1]
5280         return
5281 }
5282 citool -
5283 gui {
5284         if {[llength $argv] != 0} {
5285                 puts -nonewline stderr "usage: $argv0"
5286                 if {$subcommand ne {gui} && [appname] ne "git-$subcommand"} {
5287                         puts -nonewline stderr " $subcommand"
5288                 }
5289                 puts stderr {}
5290                 exit 1
5291         }
5292         # fall through to setup UI for commits
5293 }
5294 default {
5295         puts stderr "usage: $argv0 \[{blame|citool}\]"
5296         exit 1
5297 }
5298 }
5299
5300 # -- Branch Control
5301 #
5302 frame .branch \
5303         -borderwidth 1 \
5304         -relief sunken
5305 label .branch.l1 \
5306         -text {Current Branch:} \
5307         -anchor w \
5308         -justify left \
5309         -font font_ui
5310 label .branch.cb \
5311         -textvariable current_branch \
5312         -anchor w \
5313         -justify left \
5314         -font font_ui
5315 pack .branch.l1 -side left
5316 pack .branch.cb -side left -fill x
5317 pack .branch -side top -fill x
5318
5319 if {[is_enabled branch]} {
5320         menu .mbar.merge
5321         .mbar.merge add command -label {Local Merge...} \
5322                 -command do_local_merge \
5323                 -font font_ui
5324         lappend disable_on_lock \
5325                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5326         .mbar.merge add command -label {Abort Merge...} \
5327                 -command do_reset_hard \
5328                 -font font_ui
5329         lappend disable_on_lock \
5330                 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5331
5332
5333         menu .mbar.fetch
5334
5335         menu .mbar.push
5336         .mbar.push add command -label {Push...} \
5337                 -command do_push_anywhere \
5338                 -font font_ui
5339 }
5340
5341 # -- Main Window Layout
5342 #
5343 panedwindow .vpane -orient vertical
5344 panedwindow .vpane.files -orient horizontal
5345 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5346 pack .vpane -anchor n -side top -fill both -expand 1
5347
5348 # -- Index File List
5349 #
5350 frame .vpane.files.index -height 100 -width 200
5351 label .vpane.files.index.title -text {Changes To Be Committed} \
5352         -background green \
5353         -font font_ui
5354 text $ui_index -background white -borderwidth 0 \
5355         -width 20 -height 10 \
5356         -wrap none \
5357         -font font_ui \
5358         -cursor $cursor_ptr \
5359         -xscrollcommand {.vpane.files.index.sx set} \
5360         -yscrollcommand {.vpane.files.index.sy set} \
5361         -state disabled
5362 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5363 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5364 pack .vpane.files.index.title -side top -fill x
5365 pack .vpane.files.index.sx -side bottom -fill x
5366 pack .vpane.files.index.sy -side right -fill y
5367 pack $ui_index -side left -fill both -expand 1
5368 .vpane.files add .vpane.files.index -sticky nsew
5369
5370 # -- Working Directory File List
5371 #
5372 frame .vpane.files.workdir -height 100 -width 200
5373 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5374         -background red \
5375         -font font_ui
5376 text $ui_workdir -background white -borderwidth 0 \
5377         -width 20 -height 10 \
5378         -wrap none \
5379         -font font_ui \
5380         -cursor $cursor_ptr \
5381         -xscrollcommand {.vpane.files.workdir.sx set} \
5382         -yscrollcommand {.vpane.files.workdir.sy set} \
5383         -state disabled
5384 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5385 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5386 pack .vpane.files.workdir.title -side top -fill x
5387 pack .vpane.files.workdir.sx -side bottom -fill x
5388 pack .vpane.files.workdir.sy -side right -fill y
5389 pack $ui_workdir -side left -fill both -expand 1
5390 .vpane.files add .vpane.files.workdir -sticky nsew
5391
5392 foreach i [list $ui_index $ui_workdir] {
5393         $i tag conf in_diff -font font_uibold
5394         $i tag conf in_sel \
5395                 -background [$i cget -foreground] \
5396                 -foreground [$i cget -background]
5397 }
5398 unset i
5399
5400 # -- Diff and Commit Area
5401 #
5402 frame .vpane.lower -height 300 -width 400
5403 frame .vpane.lower.commarea
5404 frame .vpane.lower.diff -relief sunken -borderwidth 1
5405 pack .vpane.lower.commarea -side top -fill x
5406 pack .vpane.lower.diff -side bottom -fill both -expand 1
5407 .vpane add .vpane.lower -sticky nsew
5408
5409 # -- Commit Area Buttons
5410 #
5411 frame .vpane.lower.commarea.buttons
5412 label .vpane.lower.commarea.buttons.l -text {} \
5413         -anchor w \
5414         -justify left \
5415         -font font_ui
5416 pack .vpane.lower.commarea.buttons.l -side top -fill x
5417 pack .vpane.lower.commarea.buttons -side left -fill y
5418
5419 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5420         -command do_rescan \
5421         -font font_ui
5422 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5423 lappend disable_on_lock \
5424         {.vpane.lower.commarea.buttons.rescan conf -state}
5425
5426 button .vpane.lower.commarea.buttons.incall -text {Add Existing} \
5427         -command do_add_all \
5428         -font font_ui
5429 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5430 lappend disable_on_lock \
5431         {.vpane.lower.commarea.buttons.incall conf -state}
5432
5433 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5434         -command do_signoff \
5435         -font font_ui
5436 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5437
5438 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5439         -command do_commit \
5440         -font font_ui
5441 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5442 lappend disable_on_lock \
5443         {.vpane.lower.commarea.buttons.commit conf -state}
5444
5445 # -- Commit Message Buffer
5446 #
5447 frame .vpane.lower.commarea.buffer
5448 frame .vpane.lower.commarea.buffer.header
5449 set ui_comm .vpane.lower.commarea.buffer.t
5450 set ui_coml .vpane.lower.commarea.buffer.header.l
5451 radiobutton .vpane.lower.commarea.buffer.header.new \
5452         -text {New Commit} \
5453         -command do_select_commit_type \
5454         -variable selected_commit_type \
5455         -value new \
5456         -font font_ui
5457 lappend disable_on_lock \
5458         [list .vpane.lower.commarea.buffer.header.new conf -state]
5459 radiobutton .vpane.lower.commarea.buffer.header.amend \
5460         -text {Amend Last Commit} \
5461         -command do_select_commit_type \
5462         -variable selected_commit_type \
5463         -value amend \
5464         -font font_ui
5465 lappend disable_on_lock \
5466         [list .vpane.lower.commarea.buffer.header.amend conf -state]
5467 label $ui_coml \
5468         -anchor w \
5469         -justify left \
5470         -font font_ui
5471 proc trace_commit_type {varname args} {
5472         global ui_coml commit_type
5473         switch -glob -- $commit_type {
5474         initial       {set txt {Initial Commit Message:}}
5475         amend         {set txt {Amended Commit Message:}}
5476         amend-initial {set txt {Amended Initial Commit Message:}}
5477         amend-merge   {set txt {Amended Merge Commit Message:}}
5478         merge         {set txt {Merge Commit Message:}}
5479         *             {set txt {Commit Message:}}
5480         }
5481         $ui_coml conf -text $txt
5482 }
5483 trace add variable commit_type write trace_commit_type
5484 pack $ui_coml -side left -fill x
5485 pack .vpane.lower.commarea.buffer.header.amend -side right
5486 pack .vpane.lower.commarea.buffer.header.new -side right
5487
5488 text $ui_comm -background white -borderwidth 1 \
5489         -undo true \
5490         -maxundo 20 \
5491         -autoseparators true \
5492         -relief sunken \
5493         -width 75 -height 9 -wrap none \
5494         -font font_diff \
5495         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5496 scrollbar .vpane.lower.commarea.buffer.sby \
5497         -command [list $ui_comm yview]
5498 pack .vpane.lower.commarea.buffer.header -side top -fill x
5499 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5500 pack $ui_comm -side left -fill y
5501 pack .vpane.lower.commarea.buffer -side left -fill y
5502
5503 # -- Commit Message Buffer Context Menu
5504 #
5505 set ctxm .vpane.lower.commarea.buffer.ctxm
5506 menu $ctxm -tearoff 0
5507 $ctxm add command \
5508         -label {Cut} \
5509         -font font_ui \
5510         -command {tk_textCut $ui_comm}
5511 $ctxm add command \
5512         -label {Copy} \
5513         -font font_ui \
5514         -command {tk_textCopy $ui_comm}
5515 $ctxm add command \
5516         -label {Paste} \
5517         -font font_ui \
5518         -command {tk_textPaste $ui_comm}
5519 $ctxm add command \
5520         -label {Delete} \
5521         -font font_ui \
5522         -command {$ui_comm delete sel.first sel.last}
5523 $ctxm add separator
5524 $ctxm add command \
5525         -label {Select All} \
5526         -font font_ui \
5527         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5528 $ctxm add command \
5529         -label {Copy All} \
5530         -font font_ui \
5531         -command {
5532                 $ui_comm tag add sel 0.0 end
5533                 tk_textCopy $ui_comm
5534                 $ui_comm tag remove sel 0.0 end
5535         }
5536 $ctxm add separator
5537 $ctxm add command \
5538         -label {Sign Off} \
5539         -font font_ui \
5540         -command do_signoff
5541 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
5542
5543 # -- Diff Header
5544 #
5545 set current_diff_path {}
5546 set current_diff_side {}
5547 set diff_actions [list]
5548 proc trace_current_diff_path {varname args} {
5549         global current_diff_path diff_actions file_states
5550         if {$current_diff_path eq {}} {
5551                 set s {}
5552                 set f {}
5553                 set p {}
5554                 set o disabled
5555         } else {
5556                 set p $current_diff_path
5557                 set s [mapdesc [lindex $file_states($p) 0] $p]
5558                 set f {File:}
5559                 set p [escape_path $p]
5560                 set o normal
5561         }
5562
5563         .vpane.lower.diff.header.status configure -text $s
5564         .vpane.lower.diff.header.file configure -text $f
5565         .vpane.lower.diff.header.path configure -text $p
5566         foreach w $diff_actions {
5567                 uplevel #0 $w $o
5568         }
5569 }
5570 trace add variable current_diff_path write trace_current_diff_path
5571
5572 frame .vpane.lower.diff.header -background orange
5573 label .vpane.lower.diff.header.status \
5574         -background orange \
5575         -width $max_status_desc \
5576         -anchor w \
5577         -justify left \
5578         -font font_ui
5579 label .vpane.lower.diff.header.file \
5580         -background orange \
5581         -anchor w \
5582         -justify left \
5583         -font font_ui
5584 label .vpane.lower.diff.header.path \
5585         -background orange \
5586         -anchor w \
5587         -justify left \
5588         -font font_ui
5589 pack .vpane.lower.diff.header.status -side left
5590 pack .vpane.lower.diff.header.file -side left
5591 pack .vpane.lower.diff.header.path -fill x
5592 set ctxm .vpane.lower.diff.header.ctxm
5593 menu $ctxm -tearoff 0
5594 $ctxm add command \
5595         -label {Copy} \
5596         -font font_ui \
5597         -command {
5598                 clipboard clear
5599                 clipboard append \
5600                         -format STRING \
5601                         -type STRING \
5602                         -- $current_diff_path
5603         }
5604 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5605 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
5606
5607 # -- Diff Body
5608 #
5609 frame .vpane.lower.diff.body
5610 set ui_diff .vpane.lower.diff.body.t
5611 text $ui_diff -background white -borderwidth 0 \
5612         -width 80 -height 15 -wrap none \
5613         -font font_diff \
5614         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5615         -yscrollcommand {.vpane.lower.diff.body.sby set} \
5616         -state disabled
5617 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5618         -command [list $ui_diff xview]
5619 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5620         -command [list $ui_diff yview]
5621 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5622 pack .vpane.lower.diff.body.sby -side right -fill y
5623 pack $ui_diff -side left -fill both -expand 1
5624 pack .vpane.lower.diff.header -side top -fill x
5625 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5626
5627 $ui_diff tag conf d_cr -elide true
5628 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5629 $ui_diff tag conf d_+ -foreground {#00a000}
5630 $ui_diff tag conf d_- -foreground red
5631
5632 $ui_diff tag conf d_++ -foreground {#00a000}
5633 $ui_diff tag conf d_-- -foreground red
5634 $ui_diff tag conf d_+s \
5635         -foreground {#00a000} \
5636         -background {#e2effa}
5637 $ui_diff tag conf d_-s \
5638         -foreground red \
5639         -background {#e2effa}
5640 $ui_diff tag conf d_s+ \
5641         -foreground {#00a000} \
5642         -background ivory1
5643 $ui_diff tag conf d_s- \
5644         -foreground red \
5645         -background ivory1
5646
5647 $ui_diff tag conf d<<<<<<< \
5648         -foreground orange \
5649         -font font_diffbold
5650 $ui_diff tag conf d======= \
5651         -foreground orange \
5652         -font font_diffbold
5653 $ui_diff tag conf d>>>>>>> \
5654         -foreground orange \
5655         -font font_diffbold
5656
5657 $ui_diff tag raise sel
5658
5659 # -- Diff Body Context Menu
5660 #
5661 set ctxm .vpane.lower.diff.body.ctxm
5662 menu $ctxm -tearoff 0
5663 $ctxm add command \
5664         -label {Refresh} \
5665         -font font_ui \
5666         -command reshow_diff
5667 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5668 $ctxm add command \
5669         -label {Copy} \
5670         -font font_ui \
5671         -command {tk_textCopy $ui_diff}
5672 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5673 $ctxm add command \
5674         -label {Select All} \
5675         -font font_ui \
5676         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5677 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5678 $ctxm add command \
5679         -label {Copy All} \
5680         -font font_ui \
5681         -command {
5682                 $ui_diff tag add sel 0.0 end
5683                 tk_textCopy $ui_diff
5684                 $ui_diff tag remove sel 0.0 end
5685         }
5686 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5687 $ctxm add separator
5688 $ctxm add command \
5689         -label {Apply/Reverse Hunk} \
5690         -font font_ui \
5691         -command {apply_hunk $cursorX $cursorY}
5692 set ui_diff_applyhunk [$ctxm index last]
5693 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5694 $ctxm add separator
5695 $ctxm add command \
5696         -label {Decrease Font Size} \
5697         -font font_ui \
5698         -command {incr_font_size font_diff -1}
5699 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5700 $ctxm add command \
5701         -label {Increase Font Size} \
5702         -font font_ui \
5703         -command {incr_font_size font_diff 1}
5704 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5705 $ctxm add separator
5706 $ctxm add command \
5707         -label {Show Less Context} \
5708         -font font_ui \
5709         -command {if {$repo_config(gui.diffcontext) >= 2} {
5710                 incr repo_config(gui.diffcontext) -1
5711                 reshow_diff
5712         }}
5713 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5714 $ctxm add command \
5715         -label {Show More Context} \
5716         -font font_ui \
5717         -command {
5718                 incr repo_config(gui.diffcontext)
5719                 reshow_diff
5720         }
5721 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5722 $ctxm add separator
5723 $ctxm add command -label {Options...} \
5724         -font font_ui \
5725         -command do_options
5726 bind_button3 $ui_diff "
5727         set cursorX %x
5728         set cursorY %y
5729         if {\$ui_index eq \$current_diff_side} {
5730                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5731         } else {
5732                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5733         }
5734         tk_popup $ctxm %X %Y
5735 "
5736 unset ui_diff_applyhunk
5737
5738 # -- Status Bar
5739 #
5740 set ui_status_value {Initializing...}
5741 label .status -textvariable ui_status_value \
5742         -anchor w \
5743         -justify left \
5744         -borderwidth 1 \
5745         -relief sunken \
5746         -font font_ui
5747 pack .status -anchor w -side bottom -fill x
5748
5749 # -- Load geometry
5750 #
5751 catch {
5752 set gm $repo_config(gui.geometry)
5753 wm geometry . [lindex $gm 0]
5754 .vpane sash place 0 \
5755         [lindex [.vpane sash coord 0] 0] \
5756         [lindex $gm 1]
5757 .vpane.files sash place 0 \
5758         [lindex $gm 2] \
5759         [lindex [.vpane.files sash coord 0] 1]
5760 unset gm
5761 }
5762
5763 # -- Key Bindings
5764 #
5765 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5766 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5767 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5768 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5769 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5770 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5771 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5772 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5773 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5774 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5775 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5776
5777 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5778 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5779 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5780 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5781 bind $ui_diff <$M1B-Key-v> {break}
5782 bind $ui_diff <$M1B-Key-V> {break}
5783 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5784 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5785 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
5786 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
5787 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
5788 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
5789 bind $ui_diff <Button-1>   {focus %W}
5790
5791 if {[is_enabled branch]} {
5792         bind . <$M1B-Key-n> do_create_branch
5793         bind . <$M1B-Key-N> do_create_branch
5794 }
5795
5796 bind all <Key-F5> do_rescan
5797 bind all <$M1B-Key-r> do_rescan
5798 bind all <$M1B-Key-R> do_rescan
5799 bind .   <$M1B-Key-s> do_signoff
5800 bind .   <$M1B-Key-S> do_signoff
5801 bind .   <$M1B-Key-i> do_add_all
5802 bind .   <$M1B-Key-I> do_add_all
5803 bind .   <$M1B-Key-Return> do_commit
5804 foreach i [list $ui_index $ui_workdir] {
5805         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
5806         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
5807         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
5808 }
5809 unset i
5810
5811 set file_lists($ui_index) [list]
5812 set file_lists($ui_workdir) [list]
5813
5814 set HEAD {}
5815 set PARENT {}
5816 set MERGE_HEAD [list]
5817 set commit_type {}
5818 set empty_tree {}
5819 set current_branch {}
5820 set current_diff_path {}
5821 set selected_commit_type new
5822
5823 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
5824 focus -force $ui_comm
5825
5826 # -- Warn the user about environmental problems.  Cygwin's Tcl
5827 #    does *not* pass its env array onto any processes it spawns.
5828 #    This means that git processes get none of our environment.
5829 #
5830 if {[is_Cygwin]} {
5831         set ignored_env 0
5832         set suggest_user {}
5833         set msg "Possible environment issues exist.
5834
5835 The following environment variables are probably
5836 going to be ignored by any Git subprocess run
5837 by [appname]:
5838
5839 "
5840         foreach name [array names env] {
5841                 switch -regexp -- $name {
5842                 {^GIT_INDEX_FILE$} -
5843                 {^GIT_OBJECT_DIRECTORY$} -
5844                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5845                 {^GIT_DIFF_OPTS$} -
5846                 {^GIT_EXTERNAL_DIFF$} -
5847                 {^GIT_PAGER$} -
5848                 {^GIT_TRACE$} -
5849                 {^GIT_CONFIG$} -
5850                 {^GIT_CONFIG_LOCAL$} -
5851                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5852                         append msg " - $name\n"
5853                         incr ignored_env
5854                 }
5855                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5856                         append msg " - $name\n"
5857                         incr ignored_env
5858                         set suggest_user $name
5859                 }
5860                 }
5861         }
5862         if {$ignored_env > 0} {
5863                 append msg "
5864 This is due to a known issue with the
5865 Tcl binary distributed by Cygwin."
5866
5867                 if {$suggest_user ne {}} {
5868                         append msg "
5869
5870 A good replacement for $suggest_user
5871 is placing values for the user.name and
5872 user.email settings into your personal
5873 ~/.gitconfig file.
5874 "
5875                 }
5876                 warn_popup $msg
5877         }
5878         unset ignored_env msg suggest_user name
5879 }
5880
5881 # -- Only initialize complex UI if we are going to stay running.
5882 #
5883 if {[is_enabled transport]} {
5884         load_all_remotes
5885         load_all_heads
5886
5887         populate_branch_menu
5888         populate_fetch_menu
5889         populate_push_menu
5890 }
5891
5892 # -- Only suggest a gc run if we are going to stay running.
5893 #
5894 if {[is_enabled multicommit]} {
5895         set object_limit 2000
5896         if {[is_Windows]} {set object_limit 200}
5897         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5898         if {$objects_current >= $object_limit} {
5899                 if {[ask_popup \
5900                         "This repository currently has $objects_current loose objects.
5901
5902 To maintain optimal performance it is strongly
5903 recommended that you compress the database
5904 when more than $object_limit loose objects exist.
5905
5906 Compress the database now?"] eq yes} {
5907                         do_gc
5908                 }
5909         }
5910         unset object_limit _junk objects_current
5911 }
5912
5913 lock_index begin-read
5914 after 1 do_rescan