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 _reponame {}
  30
  31 proc appname {} {
  32         global _appname
  33         return $_appname
  34 }
  35
  36 proc gitdir {args} {
  37         global _gitdir
  38         if {$args eq {}} {
  39                 return $_gitdir
  40         }
  41         return [eval [concat [list file join $_gitdir] $args]]
  42 }
  43
  44 proc reponame {} {
  45         global _reponame
  46         return $_reponame
  47 }
  48
  49 ######################################################################
  50 ##
  51 ## config
  52
  53 proc is_many_config {name} {
  54         switch -glob -- $name {
  55         remote.*.fetch -
  56         remote.*.push
  57                 {return 1}
  58         *
  59                 {return 0}
  60         }
  61 }
  62
  63 proc load_config {include_global} {
  64         global repo_config global_config default_config
  65
  66         array unset global_config
  67         if {$include_global} {
  68                 catch {
  69                         set fd_rc [open "| git repo-config --global --list" r]
  70                         while {[gets $fd_rc line] >= 0} {
  71                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  72                                         if {[is_many_config $name]} {
  73                                                 lappend global_config($name) $value
  74                                         } else {
  75                                                 set global_config($name) $value
  76                                         }
  77                                 }
  78                         }
  79                         close $fd_rc
  80                 }
  81         }
  82
  83         array unset repo_config
  84         catch {
  85                 set fd_rc [open "| git repo-config --list" r]
  86                 while {[gets $fd_rc line] >= 0} {
  87                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  88                                 if {[is_many_config $name]} {
  89                                         lappend repo_config($name) $value
  90                                 } else {
  91                                         set repo_config($name) $value
  92                                 }
  93                         }
  94                 }
  95                 close $fd_rc
  96         }
  97
  98         foreach name [array names default_config] {
  99                 if {[catch {set v $global_config($name)}]} {
 100                         set global_config($name) $default_config($name)
 101                 }
 102                 if {[catch {set v $repo_config($name)}]} {
 103                         set repo_config($name) $default_config($name)
 104                 }
 105         }
 106 }
 107
 108 proc save_config {} {
 109         global default_config font_descs
 110         global repo_config global_config
 111         global repo_config_new global_config_new
 112
 113         foreach option $font_descs {
 114                 set name [lindex $option 0]
 115                 set font [lindex $option 1]
 116                 font configure $font \
 117                         -family $global_config_new(gui.$font^^family) \
 118                         -size $global_config_new(gui.$font^^size)
 119                 font configure ${font}bold \
 120                         -family $global_config_new(gui.$font^^family) \
 121                         -size $global_config_new(gui.$font^^size)
 122                 set global_config_new(gui.$name) [font configure $font]
 123                 unset global_config_new(gui.$font^^family)
 124                 unset global_config_new(gui.$font^^size)
 125         }
 126
 127         foreach name [array names default_config] {
 128                 set value $global_config_new($name)
 129                 if {$value ne $global_config($name)} {
 130                         if {$value eq $default_config($name)} {
 131                                 catch {exec git repo-config --global --unset $name}
 132                         } else {
 133                                 regsub -all "\[{}\]" $value {"} value
 134                                 exec git repo-config --global $name $value
 135                         }
 136                         set global_config($name) $value
 137                         if {$value eq $repo_config($name)} {
 138                                 catch {exec git repo-config --unset $name}
 139                                 set repo_config($name) $value
 140                         }
 141                 }
 142         }
 143
 144         foreach name [array names default_config] {
 145                 set value $repo_config_new($name)
 146                 if {$value ne $repo_config($name)} {
 147                         if {$value eq $global_config($name)} {
 148                                 catch {exec git repo-config --unset $name}
 149                         } else {
 150                                 regsub -all "\[{}\]" $value {"} value
 151                                 exec git repo-config $name $value
 152                         }
 153                         set repo_config($name) $value
 154                 }
 155         }
 156 }
 157
 158 proc error_popup {msg} {
 159         set title [appname]
 160         if {[reponame] ne {}} {
 161                 append title " ([reponame])"
 162         }
 163         set cmd [list tk_messageBox \
 164                 -icon error \
 165                 -type ok \
 166                 -title "$title: error" \
 167                 -message $msg]
 168         if {[winfo ismapped .]} {
 169                 lappend cmd -parent .
 170         }
 171         eval $cmd
 172 }
 173
 174 proc warn_popup {msg} {
 175         set title [appname]
 176         if {[reponame] ne {}} {
 177                 append title " ([reponame])"
 178         }
 179         set cmd [list tk_messageBox \
 180                 -icon warning \
 181                 -type ok \
 182                 -title "$title: warning" \
 183                 -message $msg]
 184         if {[winfo ismapped .]} {
 185                 lappend cmd -parent .
 186         }
 187         eval $cmd
 188 }
 189
 190 proc info_popup {msg} {
 191         set title [appname]
 192         if {[reponame] ne {}} {
 193                 append title " ([reponame])"
 194         }
 195         tk_messageBox \
 196                 -parent . \
 197                 -icon info \
 198                 -type ok \
 199                 -title $title \
 200                 -message $msg
 201 }
 202
 203 proc ask_popup {msg} {
 204         set title [appname]
 205         if {[reponame] ne {}} {
 206                 append title " ([reponame])"
 207         }
 208         return [tk_messageBox \
 209                 -parent . \
 210                 -icon question \
 211                 -type yesno \
 212                 -title $title \
 213                 -message $msg]
 214 }
 215
 216 ######################################################################
 217 ##
 218 ## repository setup
 219
 220 if {   [catch {set _gitdir $env(GIT_DIR)}]
 221         && [catch {set _gitdir [exec git rev-parse --git-dir]} err]} {
 222         catch {wm withdraw .}
 223         error_popup "Cannot find the git directory:\n\n$err"
 224         exit 1
 225 }
 226 if {![file isdirectory $_gitdir]} {
 227         catch {wm withdraw .}
 228         error_popup "Git directory not found:\n\n$_gitdir"
 229         exit 1
 230 }
 231 if {[lindex [file split $_gitdir] end] ne {.git}} {
 232         catch {wm withdraw .}
 233         error_popup "Cannot use funny .git directory:\n\n$gitdir"
 234         exit 1
 235 }
 236 if {[catch {cd [file dirname $_gitdir]} err]} {
 237         catch {wm withdraw .}
 238         error_popup "No working directory [file dirname $_gitdir]:\n\n$err"
 239         exit 1
 240 }
 241 set _reponame [lindex [file split \
 242         [file normalize [file dirname $_gitdir]]] \
 243         end]
 244
 245 set single_commit 0
 246 if {[appname] eq {git-citool}} {
 247         set single_commit 1
 248 }
 249
 250 ######################################################################
 251 ##
 252 ## task management
 253
 254 set rescan_active 0
 255 set diff_active 0
 256 set last_clicked {}
 257
 258 set disable_on_lock [list]
 259 set index_lock_type none
 260
 261 proc lock_index {type} {
 262         global index_lock_type disable_on_lock
 263
 264         if {$index_lock_type eq {none}} {
 265                 set index_lock_type $type
 266                 foreach w $disable_on_lock {
 267                         uplevel #0 $w disabled
 268                 }
 269                 return 1
 270         } elseif {$index_lock_type eq "begin-$type"} {
 271                 set index_lock_type $type
 272                 return 1
 273         }
 274         return 0
 275 }
 276
 277 proc unlock_index {} {
 278         global index_lock_type disable_on_lock
 279
 280         set index_lock_type none
 281         foreach w $disable_on_lock {
 282                 uplevel #0 $w normal
 283         }
 284 }
 285
 286 ######################################################################
 287 ##
 288 ## status
 289
 290 proc repository_state {ctvar hdvar mhvar} {
 291         global current_branch
 292         upvar $ctvar ct $hdvar hd $mhvar mh
 293
 294         set mh [list]
 295
 296         if {[catch {set current_branch [exec git symbolic-ref HEAD]}]} {
 297                 set current_branch {}
 298         } else {
 299                 regsub ^refs/((heads|tags|remotes)/)? \
 300                         $current_branch \
 301                         {} \
 302                         current_branch
 303         }
 304
 305         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 306                 set hd {}
 307                 set ct initial
 308                 return
 309         }
 310
 311         set merge_head [gitdir MERGE_HEAD]
 312         if {[file exists $merge_head]} {
 313                 set ct merge
 314                 set fd_mh [open $merge_head r]
 315                 while {[gets $fd_mh line] >= 0} {
 316                         lappend mh $line
 317                 }
 318                 close $fd_mh
 319                 return
 320         }
 321
 322         set ct normal
 323 }
 324
 325 proc PARENT {} {
 326         global PARENT empty_tree
 327
 328         set p [lindex $PARENT 0]
 329         if {$p ne {}} {
 330                 return $p
 331         }
 332         if {$empty_tree eq {}} {
 333                 set empty_tree [exec git mktree << {}]
 334         }
 335         return $empty_tree
 336 }
 337
 338 proc rescan {after {honor_trustmtime 1}} {
 339         global HEAD PARENT MERGE_HEAD commit_type
 340         global ui_index ui_workdir ui_status_value ui_comm
 341         global rescan_active file_states
 342         global repo_config
 343
 344         if {$rescan_active > 0 || ![lock_index read]} return
 345
 346         repository_state newType newHEAD newMERGE_HEAD
 347         if {[string match amend* $commit_type]
 348                 && $newType eq {normal}
 349                 && $newHEAD eq $HEAD} {
 350         } else {
 351                 set HEAD $newHEAD
 352                 set PARENT $newHEAD
 353                 set MERGE_HEAD $newMERGE_HEAD
 354                 set commit_type $newType
 355         }
 356
 357         array unset file_states
 358
 359         if {![$ui_comm edit modified]
 360                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 361                 if {[load_message GITGUI_MSG]} {
 362                 } elseif {[load_message MERGE_MSG]} {
 363                 } elseif {[load_message SQUASH_MSG]} {
 364                 }
 365                 $ui_comm edit reset
 366                 $ui_comm edit modified false
 367         }
 368
 369         if {$honor_trustmtime && $repo_config(gui.trustmtime) eq {true}} {
 370                 rescan_stage2 {} $after
 371         } else {
 372                 set rescan_active 1
 373                 set ui_status_value {Refreshing file status...}
 374                 set cmd [list git update-index]
 375                 lappend cmd -q
 376                 lappend cmd --unmerged
 377                 lappend cmd --ignore-missing
 378                 lappend cmd --refresh
 379                 set fd_rf [open "| $cmd" r]
 380                 fconfigure $fd_rf -blocking 0 -translation binary
 381                 fileevent $fd_rf readable \
 382                         [list rescan_stage2 $fd_rf $after]
 383         }
 384 }
 385
 386 proc rescan_stage2 {fd after} {
 387         global ui_status_value
 388         global rescan_active buf_rdi buf_rdf buf_rlo
 389
 390         if {$fd ne {}} {
 391                 read $fd
 392                 if {![eof $fd]} return
 393                 close $fd
 394         }
 395
 396         set ls_others [list | git ls-files --others -z \
 397                 --exclude-per-directory=.gitignore]
 398         set info_exclude [gitdir info exclude]
 399         if {[file readable $info_exclude]} {
 400                 lappend ls_others "--exclude-from=$info_exclude"
 401         }
 402
 403         set buf_rdi {}
 404         set buf_rdf {}
 405         set buf_rlo {}
 406
 407         set rescan_active 3
 408         set ui_status_value {Scanning for modified files ...}
 409         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 410         set fd_df [open "| git diff-files -z" r]
 411         set fd_lo [open $ls_others r]
 412
 413         fconfigure $fd_di -blocking 0 -translation binary -encoding binary
 414         fconfigure $fd_df -blocking 0 -translation binary -encoding binary
 415         fconfigure $fd_lo -blocking 0 -translation binary -encoding binary
 416         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 417         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 418         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 419 }
 420
 421 proc load_message {file} {
 422         global ui_comm
 423
 424         set f [gitdir $file]
 425         if {[file isfile $f]} {
 426                 if {[catch {set fd [open $f r]}]} {
 427                         return 0
 428                 }
 429                 set content [string trim [read $fd]]
 430                 close $fd
 431                 regsub -all -line {[ \r\t]+$} $content {} content
 432                 $ui_comm delete 0.0 end
 433                 $ui_comm insert end $content
 434                 return 1
 435         }
 436         return 0
 437 }
 438
 439 proc read_diff_index {fd after} {
 440         global buf_rdi
 441
 442         append buf_rdi [read $fd]
 443         set c 0
 444         set n [string length $buf_rdi]
 445         while {$c < $n} {
 446                 set z1 [string first "\0" $buf_rdi $c]
 447                 if {$z1 == -1} break
 448                 incr z1
 449                 set z2 [string first "\0" $buf_rdi $z1]
 450                 if {$z2 == -1} break
 451
 452                 incr c
 453                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 454                 set p [string range $buf_rdi $z1 [expr {$z2 - 1}]]
 455                 merge_state \
 456                         [encoding convertfrom $p] \
 457                         [lindex $i 4]? \
 458                         [list [lindex $i 0] [lindex $i 2]] \
 459                         [list]
 460                 set c $z2
 461                 incr c
 462         }
 463         if {$c < $n} {
 464                 set buf_rdi [string range $buf_rdi $c end]
 465         } else {
 466                 set buf_rdi {}
 467         }
 468
 469         rescan_done $fd buf_rdi $after
 470 }
 471
 472 proc read_diff_files {fd after} {
 473         global buf_rdf
 474
 475         append buf_rdf [read $fd]
 476         set c 0
 477         set n [string length $buf_rdf]
 478         while {$c < $n} {
 479                 set z1 [string first "\0" $buf_rdf $c]
 480                 if {$z1 == -1} break
 481                 incr z1
 482                 set z2 [string first "\0" $buf_rdf $z1]
 483                 if {$z2 == -1} break
 484
 485                 incr c
 486                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 487                 set p [string range $buf_rdf $z1 [expr {$z2 - 1}]]
 488                 merge_state \
 489                         [encoding convertfrom $p] \
 490                         ?[lindex $i 4] \
 491                         [list] \
 492                         [list [lindex $i 0] [lindex $i 2]]
 493                 set c $z2
 494                 incr c
 495         }
 496         if {$c < $n} {
 497                 set buf_rdf [string range $buf_rdf $c end]
 498         } else {
 499                 set buf_rdf {}
 500         }
 501
 502         rescan_done $fd buf_rdf $after
 503 }
 504
 505 proc read_ls_others {fd after} {
 506         global buf_rlo
 507
 508         append buf_rlo [read $fd]
 509         set pck [split $buf_rlo "\0"]
 510         set buf_rlo [lindex $pck end]
 511         foreach p [lrange $pck 0 end-1] {
 512                 merge_state [encoding convertfrom $p] ?O
 513         }
 514         rescan_done $fd buf_rlo $after
 515 }
 516
 517 proc rescan_done {fd buf after} {
 518         global rescan_active
 519         global file_states repo_config
 520         upvar $buf to_clear
 521
 522         if {![eof $fd]} return
 523         set to_clear {}
 524         close $fd
 525         if {[incr rescan_active -1] > 0} return
 526
 527         prune_selection
 528         unlock_index
 529         display_all_files
 530         reshow_diff
 531         uplevel #0 $after
 532 }
 533
 534 proc prune_selection {} {
 535         global file_states selected_paths
 536
 537         foreach path [array names selected_paths] {
 538                 if {[catch {set still_here $file_states($path)}]} {
 539                         unset selected_paths($path)
 540                 }
 541         }
 542 }
 543
 544 ######################################################################
 545 ##
 546 ## diff
 547
 548 proc clear_diff {} {
 549         global ui_diff current_diff_path current_diff_header
 550         global ui_index ui_workdir
 551
 552         $ui_diff conf -state normal
 553         $ui_diff delete 0.0 end
 554         $ui_diff conf -state disabled
 555
 556         set current_diff_path {}
 557         set current_diff_header {}
 558
 559         $ui_index tag remove in_diff 0.0 end
 560         $ui_workdir tag remove in_diff 0.0 end
 561 }
 562
 563 proc reshow_diff {} {
 564         global ui_status_value file_states file_lists
 565         global current_diff_path current_diff_side
 566
 567         set p $current_diff_path
 568         if {$p eq {}
 569                 || $current_diff_side eq {}
 570                 || [catch {set s $file_states($p)}]
 571                 || [lsearch -sorted $file_lists($current_diff_side) $p] == -1} {
 572                 clear_diff
 573         } else {
 574                 show_diff $p $current_diff_side
 575         }
 576 }
 577
 578 proc handle_empty_diff {} {
 579         global current_diff_path file_states file_lists
 580
 581         set path $current_diff_path
 582         set s $file_states($path)
 583         if {[lindex $s 0] ne {_M}} return
 584
 585         info_popup "No differences detected.
 586
 587 [short_path $path] has no changes.
 588
 589 The modification date of this file was updated
 590 by another application, but the content within
 591 the file was not changed.
 592
 593 A rescan will be automatically started to find
 594 other files which may have the same state."
 595
 596         clear_diff
 597         display_file $path __
 598         rescan {set ui_status_value {Ready.}} 0
 599 }
 600
 601 proc show_diff {path w {lno {}}} {
 602         global file_states file_lists
 603         global is_3way_diff diff_active repo_config
 604         global ui_diff ui_status_value ui_index ui_workdir
 605         global current_diff_path current_diff_side current_diff_header
 606
 607         if {$diff_active || ![lock_index read]} return
 608
 609         clear_diff
 610         if {$w eq {} || $lno == {}} {
 611                 foreach w [array names file_lists] {
 612                         set lno [lsearch -sorted $file_lists($w) $path]
 613                         if {$lno >= 0} {
 614                                 incr lno
 615                                 break
 616                         }
 617                 }
 618         }
 619         if {$w ne {} && $lno >= 1} {
 620                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 621         }
 622
 623         set s $file_states($path)
 624         set m [lindex $s 0]
 625         set is_3way_diff 0
 626         set diff_active 1
 627         set current_diff_path $path
 628         set current_diff_side $w
 629         set current_diff_header {}
 630         set ui_status_value "Loading diff of [escape_path $path]..."
 631
 632         # - Git won't give us the diff, there's nothing to compare to!
 633         #
 634         if {$m eq {_O}} {
 635                 set max_sz [expr {128 * 1024}]
 636                 if {[catch {
 637                                 set fd [open $path r]
 638                                 set content [read $fd $max_sz]
 639                                 close $fd
 640                                 set sz [file size $path]
 641                         } err ]} {
 642                         set diff_active 0
 643                         unlock_index
 644                         set ui_status_value "Unable to display [escape_path $path]"
 645                         error_popup "Error loading file:\n\n$err"
 646                         return
 647                 }
 648                 $ui_diff conf -state normal
 649                 if {![catch {set type [exec file $path]}]} {
 650                         set n [string length $path]
 651                         if {[string equal -length $n $path $type]} {
 652                                 set type [string range $type $n end]
 653                                 regsub {^:?\s*} $type {} type
 654                         }
 655                         $ui_diff insert end "* $type\n" d_@
 656                 }
 657                 if {[string first "\0" $content] != -1} {
 658                         $ui_diff insert end \
 659                                 "* Binary file (not showing content)." \
 660                                 d_@
 661                 } else {
 662                         if {$sz > $max_sz} {
 663                                 $ui_diff insert end \
 664 "* Untracked file is $sz bytes.
 665 * Showing only first $max_sz bytes.
 666 " d_@
 667                         }
 668                         $ui_diff insert end $content
 669                         if {$sz > $max_sz} {
 670                                 $ui_diff insert end "
 671 * Untracked file clipped here by [appname].
 672 * To see the entire file, use an external editor.
 673 " d_@
 674                         }
 675                 }
 676                 $ui_diff conf -state disabled
 677                 set diff_active 0
 678                 unlock_index
 679                 set ui_status_value {Ready.}
 680                 return
 681         }
 682
 683         set cmd [list | git]
 684         if {$w eq $ui_index} {
 685                 lappend cmd diff-index
 686                 lappend cmd --cached
 687         } elseif {$w eq $ui_workdir} {
 688                 if {[string index $m 0] eq {U}} {
 689                         lappend cmd diff
 690                 } else {
 691                         lappend cmd diff-files
 692                 }
 693         }
 694
 695         lappend cmd -p
 696         lappend cmd --no-color
 697         if {$repo_config(gui.diffcontext) > 0} {
 698                 lappend cmd "-U$repo_config(gui.diffcontext)"
 699         }
 700         if {$w eq $ui_index} {
 701                 lappend cmd [PARENT]
 702         }
 703         lappend cmd --
 704         lappend cmd $path
 705
 706         if {[catch {set fd [open $cmd r]} err]} {
 707                 set diff_active 0
 708                 unlock_index
 709                 set ui_status_value "Unable to display [escape_path $path]"
 710                 error_popup "Error loading diff:\n\n$err"
 711                 return
 712         }
 713
 714         fconfigure $fd \
 715                 -blocking 0 \
 716                 -encoding binary \
 717                 -translation binary
 718         fileevent $fd readable [list read_diff $fd]
 719 }
 720
 721 proc read_diff {fd} {
 722         global ui_diff ui_status_value diff_active
 723         global is_3way_diff current_diff_header
 724
 725         $ui_diff conf -state normal
 726         while {[gets $fd line] >= 0} {
 727                 # -- Cleanup uninteresting diff header lines.
 728                 #
 729                 if {   [string match {diff --git *}      $line]
 730                         || [string match {diff --cc *}       $line]
 731                         || [string match {diff --combined *} $line]
 732                         || [string match {--- *}             $line]
 733                         || [string match {+++ *}             $line]} {
 734                         append current_diff_header $line "\n"
 735                         continue
 736                 }
 737                 if {[string match {index *} $line]} continue
 738                 if {$line eq {deleted file mode 120000}} {
 739                         set line "deleted symlink"
 740                 }
 741
 742                 # -- Automatically detect if this is a 3 way diff.
 743                 #
 744                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 745
 746                 if {[string match {mode *} $line]
 747                         || [string match {new file *} $line]
 748                         || [string match {deleted file *} $line]
 749                         || [string match {Binary files * and * differ} $line]
 750                         || $line eq {\ No newline at end of file}
 751                         || [regexp {^\* Unmerged path } $line]} {
 752                         set tags {}
 753                 } elseif {$is_3way_diff} {
 754                         set op [string range $line 0 1]
 755                         switch -- $op {
 756                         {  } {set tags {}}
 757                         {@@} {set tags d_@}
 758                         { +} {set tags d_s+}
 759                         { -} {set tags d_s-}
 760                         {+ } {set tags d_+s}
 761                         {- } {set tags d_-s}
 762                         {--} {set tags d_--}
 763                         {++} {
 764                                 if {[regexp {^\+\+([<>]{7} |={7})} $line _g op]} {
 765                                         set line [string replace $line 0 1 {  }]
 766                                         set tags d$op
 767                                 } else {
 768                                         set tags d_++
 769                                 }
 770                         }
 771                         default {
 772                                 puts "error: Unhandled 3 way diff marker: {$op}"
 773                                 set tags {}
 774                         }
 775                         }
 776                 } else {
 777                         set op [string index $line 0]
 778                         switch -- $op {
 779                         { } {set tags {}}
 780                         {@} {set tags d_@}
 781                         {-} {set tags d_-}
 782                         {+} {
 783                                 if {[regexp {^\+([<>]{7} |={7})} $line _g op]} {
 784                                         set line [string replace $line 0 0 { }]
 785                                         set tags d$op
 786                                 } else {
 787                                         set tags d_+
 788                                 }
 789                         }
 790                         default {
 791                                 puts "error: Unhandled 2 way diff marker: {$op}"
 792                                 set tags {}
 793                         }
 794                         }
 795                 }
 796                 $ui_diff insert end $line $tags
 797                 if {[string index $line end] eq "\r"} {
 798                         $ui_diff tag add d_cr {end - 2c}
 799                 }
 800                 $ui_diff insert end "\n" $tags
 801         }
 802         $ui_diff conf -state disabled
 803
 804         if {[eof $fd]} {
 805                 close $fd
 806                 set diff_active 0
 807                 unlock_index
 808                 set ui_status_value {Ready.}
 809
 810                 if {[$ui_diff index end] eq {2.0}} {
 811                         handle_empty_diff
 812                 }
 813         }
 814 }
 815
 816 proc apply_hunk {x y} {
 817         global current_diff_path current_diff_header current_diff_side
 818         global ui_diff ui_index file_states
 819
 820         if {$current_diff_path eq {} || $current_diff_header eq {}} return
 821         if {![lock_index apply_hunk]} return
 822
 823         set apply_cmd {git apply --cached --whitespace=nowarn}
 824         set mi [lindex $file_states($current_diff_path) 0]
 825         if {$current_diff_side eq $ui_index} {
 826                 set mode unstage
 827                 lappend apply_cmd --reverse
 828                 if {[string index $mi 0] ne {M}} {
 829                         unlock_index
 830                         return
 831                 }
 832         } else {
 833                 set mode stage
 834                 if {[string index $mi 1] ne {M}} {
 835                         unlock_index
 836                         return
 837                 }
 838         }
 839
 840         set s_lno [lindex [split [$ui_diff index @$x,$y] .] 0]
 841         set s_lno [$ui_diff search -backwards -regexp ^@@ $s_lno.0 0.0]
 842         if {$s_lno eq {}} {
 843                 unlock_index
 844                 return
 845         }
 846
 847         set e_lno [$ui_diff search -forwards -regexp ^@@ "$s_lno + 1 lines" end]
 848         if {$e_lno eq {}} {
 849                 set e_lno end
 850         }
 851
 852         if {[catch {
 853                 set p [open "| $apply_cmd" w]
 854                 fconfigure $p -translation binary -encoding binary
 855                 puts -nonewline $p $current_diff_header
 856                 puts -nonewline $p [$ui_diff get $s_lno $e_lno]
 857                 close $p} err]} {
 858                 error_popup "Failed to $mode selected hunk.\n\n$err"
 859                 unlock_index
 860                 return
 861         }
 862
 863         $ui_diff conf -state normal
 864         $ui_diff delete $s_lno $e_lno
 865         $ui_diff conf -state disabled
 866
 867         if {[$ui_diff get 1.0 end] eq "\n"} {
 868                 set o _
 869         } else {
 870                 set o ?
 871         }
 872
 873         if {$current_diff_side eq $ui_index} {
 874                 set mi ${o}M
 875         } elseif {[string index $mi 0] eq {_}} {
 876                 set mi M$o
 877         } else {
 878                 set mi ?$o
 879         }
 880         unlock_index
 881         display_file $current_diff_path $mi
 882         if {$o eq {_}} {
 883                 clear_diff
 884         }
 885 }
 886
 887 ######################################################################
 888 ##
 889 ## commit
 890
 891 proc load_last_commit {} {
 892         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 893         global repo_config
 894
 895         if {[llength $PARENT] == 0} {
 896                 error_popup {There is nothing to amend.
 897
 898 You are about to create the initial commit.
 899 There is no commit before this to amend.
 900 }
 901                 return
 902         }
 903
 904         repository_state curType curHEAD curMERGE_HEAD
 905         if {$curType eq {merge}} {
 906                 error_popup {Cannot amend while merging.
 907
 908 You are currently in the middle of a merge that
 909 has not been fully completed.  You cannot amend
 910 the prior commit unless you first abort the
 911 current merge activity.
 912 }
 913                 return
 914         }
 915
 916         set msg {}
 917         set parents [list]
 918         if {[catch {
 919                         set fd [open "| git cat-file commit $curHEAD" r]
 920                         fconfigure $fd -encoding binary -translation lf
 921                         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
 922                                 set enc utf-8
 923                         }
 924                         while {[gets $fd line] > 0} {
 925                                 if {[string match {parent *} $line]} {
 926                                         lappend parents [string range $line 7 end]
 927                                 } elseif {[string match {encoding *} $line]} {
 928                                         set enc [string tolower [string range $line 9 end]]
 929                                 }
 930                         }
 931                         fconfigure $fd -encoding $enc
 932                         set msg [string trim [read $fd]]
 933                         close $fd
 934                 } err]} {
 935                 error_popup "Error loading commit data for amend:\n\n$err"
 936                 return
 937         }
 938
 939         set HEAD $curHEAD
 940         set PARENT $parents
 941         set MERGE_HEAD [list]
 942         switch -- [llength $parents] {
 943         0       {set commit_type amend-initial}
 944         1       {set commit_type amend}
 945         default {set commit_type amend-merge}
 946         }
 947
 948         $ui_comm delete 0.0 end
 949         $ui_comm insert end $msg
 950         $ui_comm edit reset
 951         $ui_comm edit modified false
 952         rescan {set ui_status_value {Ready.}}
 953 }
 954
 955 proc create_new_commit {} {
 956         global commit_type ui_comm
 957
 958         set commit_type normal
 959         $ui_comm delete 0.0 end
 960         $ui_comm edit reset
 961         $ui_comm edit modified false
 962         rescan {set ui_status_value {Ready.}}
 963 }
 964
 965 set GIT_COMMITTER_IDENT {}
 966
 967 proc committer_ident {} {
 968         global GIT_COMMITTER_IDENT
 969
 970         if {$GIT_COMMITTER_IDENT eq {}} {
 971                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 972                         error_popup "Unable to obtain your identity:\n\n$err"
 973                         return {}
 974                 }
 975                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 976                         $me me GIT_COMMITTER_IDENT]} {
 977                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 978                         return {}
 979                 }
 980         }
 981
 982         return $GIT_COMMITTER_IDENT
 983 }
 984
 985 proc commit_tree {} {
 986         global HEAD commit_type file_states ui_comm repo_config
 987         global ui_status_value pch_error
 988
 989         if {![lock_index update]} return
 990         if {[committer_ident] eq {}} return
 991
 992         # -- Our in memory state should match the repository.
 993         #
 994         repository_state curType curHEAD curMERGE_HEAD
 995         if {[string match amend* $commit_type]
 996                 && $curType eq {normal}
 997                 && $curHEAD eq $HEAD} {
 998         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 999                 info_popup {Last scanned state does not match repository state.
1000
1001 Another Git program has modified this repository
1002 since the last scan.  A rescan must be performed
1003 before another commit can be created.
1004
1005 The rescan will be automatically started now.
1006 }
1007                 unlock_index
1008                 rescan {set ui_status_value {Ready.}}
1009                 return
1010         }
1011
1012         # -- At least one file should differ in the index.
1013         #
1014         set files_ready 0
1015         foreach path [array names file_states] {
1016                 switch -glob -- [lindex $file_states($path) 0] {
1017                 _? {continue}
1018                 A? -
1019                 D? -
1020                 M? {set files_ready 1}
1021                 U? {
1022                         error_popup "Unmerged files cannot be committed.
1023
1024 File [short_path $path] has merge conflicts.
1025 You must resolve them and add the file before committing.
1026 "
1027                         unlock_index
1028                         return
1029                 }
1030                 default {
1031                         error_popup "Unknown file state [lindex $s 0] detected.
1032
1033 File [short_path $path] cannot be committed by this program.
1034 "
1035                 }
1036                 }
1037         }
1038         if {!$files_ready} {
1039                 info_popup {No changes to commit.
1040
1041 You must add at least 1 file before you can commit.
1042 }
1043                 unlock_index
1044                 return
1045         }
1046
1047         # -- A message is required.
1048         #
1049         set msg [string trim [$ui_comm get 1.0 end]]
1050         regsub -all -line {[ \t\r]+$} $msg {} msg
1051         if {$msg eq {}} {
1052                 error_popup {Please supply a commit message.
1053
1054 A good commit message has the following format:
1055
1056 - First line: Describe in one sentance what you did.
1057 - Second line: Blank
1058 - Remaining lines: Describe why this change is good.
1059 }
1060                 unlock_index
1061                 return
1062         }
1063
1064         # -- Run the pre-commit hook.
1065         #
1066         set pchook [gitdir hooks pre-commit]
1067
1068         # On Cygwin [file executable] might lie so we need to ask
1069         # the shell if the hook is executable.  Yes that's annoying.
1070         #
1071         if {[is_Windows] && [file isfile $pchook]} {
1072                 set pchook [list sh -c [concat \
1073                         "if test -x \"$pchook\";" \
1074                         "then exec \"$pchook\" 2>&1;" \
1075                         "fi"]]
1076         } elseif {[file executable $pchook]} {
1077                 set pchook [list $pchook |& cat]
1078         } else {
1079                 commit_writetree $curHEAD $msg
1080                 return
1081         }
1082
1083         set ui_status_value {Calling pre-commit hook...}
1084         set pch_error {}
1085         set fd_ph [open "| $pchook" r]
1086         fconfigure $fd_ph -blocking 0 -translation binary
1087         fileevent $fd_ph readable \
1088                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
1089 }
1090
1091 proc commit_prehook_wait {fd_ph curHEAD msg} {
1092         global pch_error ui_status_value
1093
1094         append pch_error [read $fd_ph]
1095         fconfigure $fd_ph -blocking 1
1096         if {[eof $fd_ph]} {
1097                 if {[catch {close $fd_ph}]} {
1098                         set ui_status_value {Commit declined by pre-commit hook.}
1099                         hook_failed_popup pre-commit $pch_error
1100                         unlock_index
1101                 } else {
1102                         commit_writetree $curHEAD $msg
1103                 }
1104                 set pch_error {}
1105                 return
1106         }
1107         fconfigure $fd_ph -blocking 0
1108 }
1109
1110 proc commit_writetree {curHEAD msg} {
1111         global ui_status_value
1112
1113         set ui_status_value {Committing changes...}
1114         set fd_wt [open "| git write-tree" r]
1115         fileevent $fd_wt readable \
1116                 [list commit_committree $fd_wt $curHEAD $msg]
1117 }
1118
1119 proc commit_committree {fd_wt curHEAD msg} {
1120         global HEAD PARENT MERGE_HEAD commit_type
1121         global single_commit all_heads current_branch
1122         global ui_status_value ui_comm selected_commit_type
1123         global file_states selected_paths rescan_active
1124         global repo_config
1125
1126         gets $fd_wt tree_id
1127         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1128                 error_popup "write-tree failed:\n\n$err"
1129                 set ui_status_value {Commit failed.}
1130                 unlock_index
1131                 return
1132         }
1133
1134         # -- Build the message.
1135         #
1136         set msg_p [gitdir COMMIT_EDITMSG]
1137         set msg_wt [open $msg_p w]
1138         if {[catch {set enc $repo_config(i18n.commitencoding)}]} {
1139                 set enc utf-8
1140         }
1141         fconfigure $msg_wt -encoding $enc -translation binary
1142         puts -nonewline $msg_wt $msg
1143         close $msg_wt
1144
1145         # -- Create the commit.
1146         #
1147         set cmd [list git commit-tree $tree_id]
1148         set parents [concat $PARENT $MERGE_HEAD]
1149         if {[llength $parents] > 0} {
1150                 foreach p $parents {
1151                         lappend cmd -p $p
1152                 }
1153         } else {
1154                 # git commit-tree writes to stderr during initial commit.
1155                 lappend cmd 2>/dev/null
1156         }
1157         lappend cmd <$msg_p
1158         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1159                 error_popup "commit-tree failed:\n\n$err"
1160                 set ui_status_value {Commit failed.}
1161                 unlock_index
1162                 return
1163         }
1164
1165         # -- Update the HEAD ref.
1166         #
1167         set reflogm commit
1168         if {$commit_type ne {normal}} {
1169                 append reflogm " ($commit_type)"
1170         }
1171         set i [string first "\n" $msg]
1172         if {$i >= 0} {
1173                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1174         } else {
1175                 append reflogm {: } $msg
1176         }
1177         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1178         if {[catch {eval exec $cmd} err]} {
1179                 error_popup "update-ref failed:\n\n$err"
1180                 set ui_status_value {Commit failed.}
1181                 unlock_index
1182                 return
1183         }
1184
1185         # -- Make sure our current branch exists.
1186         #
1187         if {$commit_type eq {initial}} {
1188                 lappend all_heads $current_branch
1189                 set all_heads [lsort -unique $all_heads]
1190                 populate_branch_menu
1191         }
1192
1193         # -- Cleanup after ourselves.
1194         #
1195         catch {file delete $msg_p}
1196         catch {file delete [gitdir MERGE_HEAD]}
1197         catch {file delete [gitdir MERGE_MSG]}
1198         catch {file delete [gitdir SQUASH_MSG]}
1199         catch {file delete [gitdir GITGUI_MSG]}
1200
1201         # -- Let rerere do its thing.
1202         #
1203         if {[file isdirectory [gitdir rr-cache]]} {
1204                 catch {exec git rerere}
1205         }
1206
1207         # -- Run the post-commit hook.
1208         #
1209         set pchook [gitdir hooks post-commit]
1210         if {[is_Windows] && [file isfile $pchook]} {
1211                 set pchook [list sh -c [concat \
1212                         "if test -x \"$pchook\";" \
1213                         "then exec \"$pchook\";" \
1214                         "fi"]]
1215         } elseif {![file executable $pchook]} {
1216                 set pchook {}
1217         }
1218         if {$pchook ne {}} {
1219                 catch {exec $pchook &}
1220         }
1221
1222         $ui_comm delete 0.0 end
1223         $ui_comm edit reset
1224         $ui_comm edit modified false
1225
1226         if {$single_commit} do_quit
1227
1228         # -- Update in memory status
1229         #
1230         set selected_commit_type new
1231         set commit_type normal
1232         set HEAD $cmt_id
1233         set PARENT $cmt_id
1234         set MERGE_HEAD [list]
1235
1236         foreach path [array names file_states] {
1237                 set s $file_states($path)
1238                 set m [lindex $s 0]
1239                 switch -glob -- $m {
1240                 _O -
1241                 _M -
1242                 _D {continue}
1243                 __ -
1244                 A_ -
1245                 M_ -
1246                 D_ {
1247                         unset file_states($path)
1248                         catch {unset selected_paths($path)}
1249                 }
1250                 DO {
1251                         set file_states($path) [list _O [lindex $s 1] {} {}]
1252                 }
1253                 AM -
1254                 AD -
1255                 MM -
1256                 MD {
1257                         set file_states($path) [list \
1258                                 _[string index $m 1] \
1259                                 [lindex $s 1] \
1260                                 [lindex $s 3] \
1261                                 {}]
1262                 }
1263                 }
1264         }
1265
1266         display_all_files
1267         unlock_index
1268         reshow_diff
1269         set ui_status_value \
1270                 "Changes committed as [string range $cmt_id 0 7]."
1271 }
1272
1273 ######################################################################
1274 ##
1275 ## fetch pull push
1276
1277 proc fetch_from {remote} {
1278         set w [new_console "fetch $remote" \
1279                 "Fetching new changes from $remote"]
1280         set cmd [list git fetch]
1281         lappend cmd $remote
1282         console_exec $w $cmd
1283 }
1284
1285 proc pull_remote {remote branch} {
1286         global HEAD commit_type file_states repo_config
1287
1288         if {![lock_index update]} return
1289
1290         # -- Our in memory state should match the repository.
1291         #
1292         repository_state curType curHEAD curMERGE_HEAD
1293         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1294                 info_popup {Last scanned state does not match repository state.
1295
1296 Another Git program has modified this repository
1297 since the last scan.  A rescan must be performed
1298 before a pull operation can be started.
1299
1300 The rescan will be automatically started now.
1301 }
1302                 unlock_index
1303                 rescan {set ui_status_value {Ready.}}
1304                 return
1305         }
1306
1307         # -- No differences should exist before a pull.
1308         #
1309         if {[array size file_states] != 0} {
1310                 error_popup {Uncommitted but modified files are present.
1311
1312 You should not perform a pull with unmodified
1313 files in your working directory as Git will be
1314 unable to recover from an incorrect merge.
1315
1316 You should commit or revert all changes before
1317 starting a pull operation.
1318 }
1319                 unlock_index
1320                 return
1321         }
1322
1323         set w [new_console "pull $remote $branch" \
1324                 "Pulling new changes from branch $branch in $remote"]
1325         set cmd [list git pull]
1326         if {$repo_config(gui.pullsummary) eq {false}} {
1327                 lappend cmd --no-summary
1328         }
1329         lappend cmd $remote
1330         lappend cmd $branch
1331         console_exec $w $cmd [list post_pull_remote $remote $branch]
1332 }
1333
1334 proc post_pull_remote {remote branch success} {
1335         global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1336         global ui_status_value
1337
1338         unlock_index
1339         if {$success} {
1340                 repository_state commit_type HEAD MERGE_HEAD
1341                 set PARENT $HEAD
1342                 set selected_commit_type new
1343                 set ui_status_value "Pulling $branch from $remote complete."
1344         } else {
1345                 rescan [list set ui_status_value \
1346                         "Conflicts detected while pulling $branch from $remote."]
1347         }
1348 }
1349
1350 proc push_to {remote} {
1351         set w [new_console "push $remote" \
1352                 "Pushing changes to $remote"]
1353         set cmd [list git push]
1354         lappend cmd $remote
1355         console_exec $w $cmd
1356 }
1357
1358 ######################################################################
1359 ##
1360 ## ui helpers
1361
1362 proc mapicon {w state path} {
1363         global all_icons
1364
1365         if {[catch {set r $all_icons($state$w)}]} {
1366                 puts "error: no icon for $w state={$state} $path"
1367                 return file_plain
1368         }
1369         return $r
1370 }
1371
1372 proc mapdesc {state path} {
1373         global all_descs
1374
1375         if {[catch {set r $all_descs($state)}]} {
1376                 puts "error: no desc for state={$state} $path"
1377                 return $state
1378         }
1379         return $r
1380 }
1381
1382 proc escape_path {path} {
1383         regsub -all "\n" $path "\\n" path
1384         return $path
1385 }
1386
1387 proc short_path {path} {
1388         return [escape_path [lindex [file split $path] end]]
1389 }
1390
1391 set next_icon_id 0
1392 set null_sha1 [string repeat 0 40]
1393
1394 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1395         global file_states next_icon_id null_sha1
1396
1397         set s0 [string index $new_state 0]
1398         set s1 [string index $new_state 1]
1399
1400         if {[catch {set info $file_states($path)}]} {
1401                 set state __
1402                 set icon n[incr next_icon_id]
1403         } else {
1404                 set state [lindex $info 0]
1405                 set icon [lindex $info 1]
1406                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1407                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1408         }
1409
1410         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1411         elseif {$s0 eq {_}} {set s0 _}
1412
1413         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1414         elseif {$s1 eq {_}} {set s1 _}
1415
1416         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1417                 set head_info [list 0 $null_sha1]
1418         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1419                 && $head_info eq {}} {
1420                 set head_info $index_info
1421         }
1422
1423         set file_states($path) [list $s0$s1 $icon \
1424                 $head_info $index_info \
1425                 ]
1426         return $state
1427 }
1428
1429 proc display_file_helper {w path icon_name old_m new_m} {
1430         global file_lists
1431
1432         if {$new_m eq {_}} {
1433                 set lno [lsearch -sorted $file_lists($w) $path]
1434                 if {$lno >= 0} {
1435                         set file_lists($w) [lreplace $file_lists($w) $lno $lno]
1436                         incr lno
1437                         $w conf -state normal
1438                         $w delete $lno.0 [expr {$lno + 1}].0
1439                         $w conf -state disabled
1440                 }
1441         } elseif {$old_m eq {_} && $new_m ne {_}} {
1442                 lappend file_lists($w) $path
1443                 set file_lists($w) [lsort -unique $file_lists($w)]
1444                 set lno [lsearch -sorted $file_lists($w) $path]
1445                 incr lno
1446                 $w conf -state normal
1447                 $w image create $lno.0 \
1448                         -align center -padx 5 -pady 1 \
1449                         -name $icon_name \
1450                         -image [mapicon $w $new_m $path]
1451                 $w insert $lno.1 "[escape_path $path]\n"
1452                 $w conf -state disabled
1453         } elseif {$old_m ne $new_m} {
1454                 $w conf -state normal
1455                 $w image conf $icon_name -image [mapicon $w $new_m $path]
1456                 $w conf -state disabled
1457         }
1458 }
1459
1460 proc display_file {path state} {
1461         global file_states selected_paths
1462         global ui_index ui_workdir
1463
1464         set old_m [merge_state $path $state]
1465         set s $file_states($path)
1466         set new_m [lindex $s 0]
1467         set icon_name [lindex $s 1]
1468
1469         set o [string index $old_m 0]
1470         set n [string index $new_m 0]
1471         if {$o eq {U}} {
1472                 set o _
1473         }
1474         if {$n eq {U}} {
1475                 set n _
1476         }
1477         display_file_helper     $ui_index $path $icon_name $o $n
1478
1479         if {[string index $old_m 0] eq {U}} {
1480                 set o U
1481         } else {
1482                 set o [string index $old_m 1]
1483         }
1484         if {[string index $new_m 0] eq {U}} {
1485                 set n U
1486         } else {
1487                 set n [string index $new_m 1]
1488         }
1489         display_file_helper     $ui_workdir $path $icon_name $o $n
1490
1491         if {$new_m eq {__}} {
1492                 unset file_states($path)
1493                 catch {unset selected_paths($path)}
1494         }
1495 }
1496
1497 proc display_all_files_helper {w path icon_name m} {
1498         global file_lists
1499
1500         lappend file_lists($w) $path
1501         set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1502         $w image create end \
1503                 -align center -padx 5 -pady 1 \
1504                 -name $icon_name \
1505                 -image [mapicon $w $m $path]
1506         $w insert end "[escape_path $path]\n"
1507 }
1508
1509 proc display_all_files {} {
1510         global ui_index ui_workdir
1511         global file_states file_lists
1512         global last_clicked
1513
1514         $ui_index conf -state normal
1515         $ui_workdir conf -state normal
1516
1517         $ui_index delete 0.0 end
1518         $ui_workdir delete 0.0 end
1519         set last_clicked {}
1520
1521         set file_lists($ui_index) [list]
1522         set file_lists($ui_workdir) [list]
1523
1524         foreach path [lsort [array names file_states]] {
1525                 set s $file_states($path)
1526                 set m [lindex $s 0]
1527                 set icon_name [lindex $s 1]
1528
1529                 set s [string index $m 0]
1530                 if {$s ne {U} && $s ne {_}} {
1531                         display_all_files_helper $ui_index $path \
1532                                 $icon_name $s
1533                 }
1534
1535                 if {[string index $m 0] eq {U}} {
1536                         set s U
1537                 } else {
1538                         set s [string index $m 1]
1539                 }
1540                 if {$s ne {_}} {
1541                         display_all_files_helper $ui_workdir $path \
1542                                 $icon_name $s
1543                 }
1544         }
1545
1546         $ui_index conf -state disabled
1547         $ui_workdir conf -state disabled
1548 }
1549
1550 proc update_indexinfo {msg pathList after} {
1551         global update_index_cp ui_status_value
1552
1553         if {![lock_index update]} return
1554
1555         set update_index_cp 0
1556         set pathList [lsort $pathList]
1557         set totalCnt [llength $pathList]
1558         set batch [expr {int($totalCnt * .01) + 1}]
1559         if {$batch > 25} {set batch 25}
1560
1561         set ui_status_value [format \
1562                 "$msg... %i/%i files (%.2f%%)" \
1563                 $update_index_cp \
1564                 $totalCnt \
1565                 0.0]
1566         set fd [open "| git update-index -z --index-info" w]
1567         fconfigure $fd \
1568                 -blocking 0 \
1569                 -buffering full \
1570                 -buffersize 512 \
1571                 -encoding binary \
1572                 -translation binary
1573         fileevent $fd writable [list \
1574                 write_update_indexinfo \
1575                 $fd \
1576                 $pathList \
1577                 $totalCnt \
1578                 $batch \
1579                 $msg \
1580                 $after \
1581                 ]
1582 }
1583
1584 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1585         global update_index_cp ui_status_value
1586         global file_states current_diff_path
1587
1588         if {$update_index_cp >= $totalCnt} {
1589                 close $fd
1590                 unlock_index
1591                 uplevel #0 $after
1592                 return
1593         }
1594
1595         for {set i $batch} \
1596                 {$update_index_cp < $totalCnt && $i > 0} \
1597                 {incr i -1} {
1598                 set path [lindex $pathList $update_index_cp]
1599                 incr update_index_cp
1600
1601                 set s $file_states($path)
1602                 switch -glob -- [lindex $s 0] {
1603                 A? {set new _O}
1604                 M? {set new _M}
1605                 D_ {set new _D}
1606                 D? {set new _?}
1607                 ?? {continue}
1608                 }
1609                 set info [lindex $s 2]
1610                 if {$info eq {}} continue
1611
1612                 puts -nonewline $fd "$info\t[encoding convertto $path]\0"
1613                 display_file $path $new
1614         }
1615
1616         set ui_status_value [format \
1617                 "$msg... %i/%i files (%.2f%%)" \
1618                 $update_index_cp \
1619                 $totalCnt \
1620                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1621 }
1622
1623 proc update_index {msg pathList after} {
1624         global update_index_cp ui_status_value
1625
1626         if {![lock_index update]} return
1627
1628         set update_index_cp 0
1629         set pathList [lsort $pathList]
1630         set totalCnt [llength $pathList]
1631         set batch [expr {int($totalCnt * .01) + 1}]
1632         if {$batch > 25} {set batch 25}
1633
1634         set ui_status_value [format \
1635                 "$msg... %i/%i files (%.2f%%)" \
1636                 $update_index_cp \
1637                 $totalCnt \
1638                 0.0]
1639         set fd [open "| git update-index --add --remove -z --stdin" w]
1640         fconfigure $fd \
1641                 -blocking 0 \
1642                 -buffering full \
1643                 -buffersize 512 \
1644                 -encoding binary \
1645                 -translation binary
1646         fileevent $fd writable [list \
1647                 write_update_index \
1648                 $fd \
1649                 $pathList \
1650                 $totalCnt \
1651                 $batch \
1652                 $msg \
1653                 $after \
1654                 ]
1655 }
1656
1657 proc write_update_index {fd pathList totalCnt batch msg after} {
1658         global update_index_cp ui_status_value
1659         global file_states current_diff_path
1660
1661         if {$update_index_cp >= $totalCnt} {
1662                 close $fd
1663                 unlock_index
1664                 uplevel #0 $after
1665                 return
1666         }
1667
1668         for {set i $batch} \
1669                 {$update_index_cp < $totalCnt && $i > 0} \
1670                 {incr i -1} {
1671                 set path [lindex $pathList $update_index_cp]
1672                 incr update_index_cp
1673
1674                 switch -glob -- [lindex $file_states($path) 0] {
1675                 AD {set new __}
1676                 ?D {set new D_}
1677                 _O -
1678                 AM {set new A_}
1679                 U? {
1680                         if {[file exists $path]} {
1681                                 set new M_
1682                         } else {
1683                                 set new D_
1684                         }
1685                 }
1686                 ?M {set new M_}
1687                 ?? {continue}
1688                 }
1689                 puts -nonewline $fd "[encoding convertto $path]\0"
1690                 display_file $path $new
1691         }
1692
1693         set ui_status_value [format \
1694                 "$msg... %i/%i files (%.2f%%)" \
1695                 $update_index_cp \
1696                 $totalCnt \
1697                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1698 }
1699
1700 proc checkout_index {msg pathList after} {
1701         global update_index_cp ui_status_value
1702
1703         if {![lock_index update]} return
1704
1705         set update_index_cp 0
1706         set pathList [lsort $pathList]
1707         set totalCnt [llength $pathList]
1708         set batch [expr {int($totalCnt * .01) + 1}]
1709         if {$batch > 25} {set batch 25}
1710
1711         set ui_status_value [format \
1712                 "$msg... %i/%i files (%.2f%%)" \
1713                 $update_index_cp \
1714                 $totalCnt \
1715                 0.0]
1716         set cmd [list git checkout-index]
1717         lappend cmd --index
1718         lappend cmd --quiet
1719         lappend cmd --force
1720         lappend cmd -z
1721         lappend cmd --stdin
1722         set fd [open "| $cmd " w]
1723         fconfigure $fd \
1724                 -blocking 0 \
1725                 -buffering full \
1726                 -buffersize 512 \
1727                 -encoding binary \
1728                 -translation binary
1729         fileevent $fd writable [list \
1730                 write_checkout_index \
1731                 $fd \
1732                 $pathList \
1733                 $totalCnt \
1734                 $batch \
1735                 $msg \
1736                 $after \
1737                 ]
1738 }
1739
1740 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1741         global update_index_cp ui_status_value
1742         global file_states current_diff_path
1743
1744         if {$update_index_cp >= $totalCnt} {
1745                 close $fd
1746                 unlock_index
1747                 uplevel #0 $after
1748                 return
1749         }
1750
1751         for {set i $batch} \
1752                 {$update_index_cp < $totalCnt && $i > 0} \
1753                 {incr i -1} {
1754                 set path [lindex $pathList $update_index_cp]
1755                 incr update_index_cp
1756                 switch -glob -- [lindex $file_states($path) 0] {
1757                 U? {continue}
1758                 ?M -
1759                 ?D {
1760                         puts -nonewline $fd "[encoding convertto $path]\0"
1761                         display_file $path ?_
1762                 }
1763                 }
1764         }
1765
1766         set ui_status_value [format \
1767                 "$msg... %i/%i files (%.2f%%)" \
1768                 $update_index_cp \
1769                 $totalCnt \
1770                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1771 }
1772
1773 ######################################################################
1774 ##
1775 ## branch management
1776
1777 proc is_tracking_branch {name} {
1778         global tracking_branches
1779
1780         if {![catch {set info $tracking_branches($name)}]} {
1781                 return 1
1782         }
1783         foreach t [array names tracking_branches] {
1784                 if {[string match {*/\*} $t] && [string match $t $name]} {
1785                         return 1
1786                 }
1787         }
1788         return 0
1789 }
1790
1791 proc load_all_heads {} {
1792         global all_heads
1793
1794         set all_heads [list]
1795         set fd [open "| git for-each-ref --format=%(refname) refs/heads" r]
1796         while {[gets $fd line] > 0} {
1797                 if {[is_tracking_branch $line]} continue
1798                 if {![regsub ^refs/heads/ $line {} name]} continue
1799                 lappend all_heads $name
1800         }
1801         close $fd
1802
1803         set all_heads [lsort $all_heads]
1804 }
1805
1806 proc populate_branch_menu {} {
1807         global all_heads disable_on_lock
1808
1809         set m .mbar.branch
1810         set last [$m index last]
1811         for {set i 0} {$i <= $last} {incr i} {
1812                 if {[$m type $i] eq {separator}} {
1813                         $m delete $i last
1814                         set new_dol [list]
1815                         foreach a $disable_on_lock {
1816                                 if {[lindex $a 0] ne $m || [lindex $a 2] < $i} {
1817                                         lappend new_dol $a
1818                                 }
1819                         }
1820                         set disable_on_lock $new_dol
1821                         break
1822                 }
1823         }
1824
1825         $m add separator
1826         foreach b $all_heads {
1827                 $m add radiobutton \
1828                         -label $b \
1829                         -command [list switch_branch $b] \
1830                         -variable current_branch \
1831                         -value $b \
1832                         -font font_ui
1833                 lappend disable_on_lock \
1834                         [list $m entryconf [$m index last] -state]
1835         }
1836 }
1837
1838 proc all_tracking_branches {} {
1839         global tracking_branches
1840
1841         set all_trackings {}
1842         set cmd {}
1843         foreach name [array names tracking_branches] {
1844                 if {[regsub {/\*$} $name {} name]} {
1845                         lappend cmd $name
1846                 } else {
1847                         regsub ^refs/(heads|remotes)/ $name {} name
1848                         lappend all_trackings $name
1849                 }
1850         }
1851
1852         if {$cmd ne {}} {
1853                 set fd [open "| git for-each-ref --format=%(refname) $cmd" r]
1854                 while {[gets $fd name] > 0} {
1855                         regsub ^refs/(heads|remotes)/ $name {} name
1856                         lappend all_trackings $name
1857                 }
1858                 close $fd
1859         }
1860
1861         return [lsort -unique $all_trackings]
1862 }
1863
1864 proc do_create_branch_action {w} {
1865         global all_heads null_sha1 repo_config
1866         global create_branch_checkout create_branch_revtype
1867         global create_branch_head create_branch_trackinghead
1868
1869         set newbranch [string trim [$w.desc.name_t get 0.0 end]]
1870         if {$newbranch eq {}
1871                 || $newbranch eq $repo_config(gui.newbranchtemplate)} {
1872                 tk_messageBox \
1873                         -icon error \
1874                         -type ok \
1875                         -title [wm title $w] \
1876                         -parent $w \
1877                         -message "Please supply a branch name."
1878                 focus $w.desc.name_t
1879                 return
1880         }
1881         if {![catch {exec git show-ref --verify -- "refs/heads/$newbranch"}]} {
1882                 tk_messageBox \
1883                         -icon error \
1884                         -type ok \
1885                         -title [wm title $w] \
1886                         -parent $w \
1887                         -message "Branch '$newbranch' already exists."
1888                 focus $w.desc.name_t
1889                 return
1890         }
1891         if {[catch {exec git check-ref-format "heads/$newbranch"}]} {
1892                 tk_messageBox \
1893                         -icon error \
1894                         -type ok \
1895                         -title [wm title $w] \
1896                         -parent $w \
1897                         -message "We do not like '$newbranch' as a branch name."
1898                 focus $w.desc.name_t
1899                 return
1900         }
1901
1902         set rev {}
1903         switch -- $create_branch_revtype {
1904         head {set rev $create_branch_head}
1905         tracking {set rev $create_branch_trackinghead}
1906         expression {set rev [string trim [$w.from.exp_t get 0.0 end]]}
1907         }
1908         if {[catch {set cmt [exec git rev-parse --verify "${rev}^0"]}]} {
1909                 tk_messageBox \
1910                         -icon error \
1911                         -type ok \
1912                         -title [wm title $w] \
1913                         -parent $w \
1914                         -message "Invalid starting revision: $rev"
1915                 return
1916         }
1917         set cmd [list git update-ref]
1918         lappend cmd -m
1919         lappend cmd "branch: Created from $rev"
1920         lappend cmd "refs/heads/$newbranch"
1921         lappend cmd $cmt
1922         lappend cmd $null_sha1
1923         if {[catch {eval exec $cmd} err]} {
1924                 tk_messageBox \
1925                         -icon error \
1926                         -type ok \
1927                         -title [wm title $w] \
1928                         -parent $w \
1929                         -message "Failed to create '$newbranch'.\n\n$err"
1930                 return
1931         }
1932
1933         lappend all_heads $newbranch
1934         set all_heads [lsort $all_heads]
1935         populate_branch_menu
1936         destroy $w
1937         if {$create_branch_checkout} {
1938                 switch_branch $newbranch
1939         }
1940 }
1941
1942 proc radio_selector {varname value args} {
1943         upvar #0 $varname var
1944         set var $value
1945 }
1946
1947 trace add variable create_branch_head write \
1948         [list radio_selector create_branch_revtype head]
1949 trace add variable create_branch_trackinghead write \
1950         [list radio_selector create_branch_revtype tracking]
1951
1952 trace add variable delete_branch_head write \
1953         [list radio_selector delete_branch_checktype head]
1954 trace add variable delete_branch_trackinghead write \
1955         [list radio_selector delete_branch_checktype tracking]
1956
1957 proc do_create_branch {} {
1958         global all_heads current_branch repo_config
1959         global create_branch_checkout create_branch_revtype
1960         global create_branch_head create_branch_trackinghead
1961
1962         set w .branch_editor
1963         toplevel $w
1964         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1965
1966         label $w.header -text {Create New Branch} \
1967                 -font font_uibold
1968         pack $w.header -side top -fill x
1969
1970         frame $w.buttons
1971         button $w.buttons.create -text Create \
1972                 -font font_ui \
1973                 -default active \
1974                 -command [list do_create_branch_action $w]
1975         pack $w.buttons.create -side right
1976         button $w.buttons.cancel -text {Cancel} \
1977                 -font font_ui \
1978                 -command [list destroy $w]
1979         pack $w.buttons.cancel -side right -padx 5
1980         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1981
1982         labelframe $w.desc \
1983                 -text {Branch Description} \
1984                 -font font_ui
1985         label $w.desc.name_l -text {Name:} -font font_ui
1986         text $w.desc.name_t \
1987                 -borderwidth 1 \
1988                 -relief sunken \
1989                 -height 1 \
1990                 -width 40 \
1991                 -font font_ui
1992         $w.desc.name_t insert 0.0 $repo_config(gui.newbranchtemplate)
1993         grid $w.desc.name_l $w.desc.name_t -sticky we -padx {0 5}
1994         bind $w.desc.name_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
1995         bind $w.desc.name_t <Key-Tab> {focus [tk_focusNext %W];break}
1996         bind $w.desc.name_t <Key-Return> "do_create_branch_action $w;break"
1997         bind $w.desc.name_t <Key> {
1998                 if {{%K} ne {BackSpace}
1999                         && {%K} ne {Tab}
2000                         && {%K} ne {Escape}
2001                         && {%K} ne {Return}} {
2002                         if {%k <= 32} break
2003                         if {[string first %A {~^:?*[}] >= 0} break
2004                 }
2005         }
2006         grid columnconfigure $w.desc 1 -weight 1
2007         pack $w.desc -anchor nw -fill x -pady 5 -padx 5
2008
2009         labelframe $w.from \
2010                 -text {Starting Revision} \
2011                 -font font_ui
2012         radiobutton $w.from.head_r \
2013                 -text {Local Branch:} \
2014                 -value head \
2015                 -variable create_branch_revtype \
2016                 -font font_ui
2017         eval tk_optionMenu $w.from.head_m create_branch_head $all_heads
2018         grid $w.from.head_r $w.from.head_m -sticky w
2019         set all_trackings [all_tracking_branches]
2020         if {$all_trackings ne {}} {
2021                 set create_branch_trackinghead [lindex $all_trackings 0]
2022                 radiobutton $w.from.tracking_r \
2023                         -text {Tracking Branch:} \
2024                         -value tracking \
2025                         -variable create_branch_revtype \
2026                         -font font_ui
2027                 eval tk_optionMenu $w.from.tracking_m \
2028                         create_branch_trackinghead \
2029                         $all_trackings
2030                 grid $w.from.tracking_r $w.from.tracking_m -sticky w
2031         }
2032         radiobutton $w.from.exp_r \
2033                 -text {Revision Expression:} \
2034                 -value expression \
2035                 -variable create_branch_revtype \
2036                 -font font_ui
2037         text $w.from.exp_t \
2038                 -borderwidth 1 \
2039                 -relief sunken \
2040                 -height 1 \
2041                 -width 50 \
2042                 -font font_ui
2043         grid $w.from.exp_r $w.from.exp_t -sticky we -padx {0 5}
2044         bind $w.from.exp_t <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
2045         bind $w.from.exp_t <Key-Tab> {focus [tk_focusNext %W];break}
2046         bind $w.from.exp_t <Key-Return> "do_create_branch_action $w;break"
2047         bind $w.from.exp_t <Key-space> break
2048         bind $w.from.exp_t <Key> {set create_branch_revtype expression}
2049         grid columnconfigure $w.from 1 -weight 1
2050         pack $w.from -anchor nw -fill x -pady 5 -padx 5
2051
2052         labelframe $w.postActions \
2053                 -text {Post Creation Actions} \
2054                 -font font_ui
2055         checkbutton $w.postActions.checkout \
2056                 -text {Checkout after creation} \
2057                 -variable create_branch_checkout \
2058                 -font font_ui
2059         pack $w.postActions.checkout -anchor nw
2060         pack $w.postActions -anchor nw -fill x -pady 5 -padx 5
2061
2062         set create_branch_checkout 1
2063         set create_branch_head $current_branch
2064         set create_branch_revtype head
2065
2066         bind $w <Visibility> "grab $w; focus $w.desc.name_t"
2067         bind $w <Key-Escape> "destroy $w"
2068         bind $w <Key-Return> "do_create_branch_action $w;break"
2069         wm title $w "[appname] ([reponame]): Create Branch"
2070         tkwait window $w
2071 }
2072
2073 proc do_delete_branch_action {w} {
2074         global all_heads
2075         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2076
2077         set check_rev {}
2078         switch -- $delete_branch_checktype {
2079         head {set check_rev $delete_branch_head}
2080         tracking {set check_rev $delete_branch_trackinghead}
2081         always {set check_rev {:none}}
2082         }
2083         if {$check_rev eq {:none}} {
2084                 set check_cmt {}
2085         } elseif {[catch {set check_cmt [exec git rev-parse --verify "${check_rev}^0"]}]} {
2086                 tk_messageBox \
2087                         -icon error \
2088                         -type ok \
2089                         -title [wm title $w] \
2090                         -parent $w \
2091                         -message "Invalid check revision: $check_rev"
2092                 return
2093         }
2094
2095         set to_delete [list]
2096         set not_merged [list]
2097         foreach i [$w.list.l curselection] {
2098                 set b [$w.list.l get $i]
2099                 if {[catch {set o [exec git rev-parse --verify $b]}]} continue
2100                 if {$check_cmt ne {}} {
2101                         if {$b eq $check_rev} continue
2102                         if {[catch {set m [exec git merge-base $o $check_cmt]}]} continue
2103                         if {$o ne $m} {
2104                                 lappend not_merged $b
2105                                 continue
2106                         }
2107                 }
2108                 lappend to_delete [list $b $o]
2109         }
2110         if {$not_merged ne {}} {
2111                 set msg "The following branches are not completely merged into $check_rev:
2112
2113  - [join $not_merged "\n - "]"
2114                 tk_messageBox \
2115                         -icon info \
2116                         -type ok \
2117                         -title [wm title $w] \
2118                         -parent $w \
2119                         -message $msg
2120         }
2121         if {$to_delete eq {}} return
2122         if {$delete_branch_checktype eq {always}} {
2123                 set msg {Recovering deleted branches is difficult.
2124
2125 Delete the selected branches?}
2126                 if {[tk_messageBox \
2127                         -icon warning \
2128                         -type yesno \
2129                         -title [wm title $w] \
2130                         -parent $w \
2131                         -message $msg] ne yes} {
2132                         return
2133                 }
2134         }
2135
2136         set failed {}
2137         foreach i $to_delete {
2138                 set b [lindex $i 0]
2139                 set o [lindex $i 1]
2140                 if {[catch {exec git update-ref -d "refs/heads/$b" $o} err]} {
2141                         append failed " - $b: $err\n"
2142                 } else {
2143                         set x [lsearch -sorted $all_heads $b]
2144                         if {$x >= 0} {
2145                                 set all_heads [lreplace $all_heads $x $x]
2146                         }
2147                 }
2148         }
2149
2150         if {$failed ne {}} {
2151                 tk_messageBox \
2152                         -icon error \
2153                         -type ok \
2154                         -title [wm title $w] \
2155                         -parent $w \
2156                         -message "Failed to delete branches:\n$failed"
2157         }
2158
2159         set all_heads [lsort $all_heads]
2160         populate_branch_menu
2161         destroy $w
2162 }
2163
2164 proc do_delete_branch {} {
2165         global all_heads tracking_branches current_branch
2166         global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2167
2168         set w .branch_editor
2169         toplevel $w
2170         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2171
2172         label $w.header -text {Delete Local Branch} \
2173                 -font font_uibold
2174         pack $w.header -side top -fill x
2175
2176         frame $w.buttons
2177         button $w.buttons.create -text Delete \
2178                 -font font_ui \
2179                 -command [list do_delete_branch_action $w]
2180         pack $w.buttons.create -side right
2181         button $w.buttons.cancel -text {Cancel} \
2182                 -font font_ui \
2183                 -command [list destroy $w]
2184         pack $w.buttons.cancel -side right -padx 5
2185         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2186
2187         labelframe $w.list \
2188                 -text {Local Branches} \
2189                 -font font_ui
2190         listbox $w.list.l \
2191                 -height 10 \
2192                 -width 50 \
2193                 -selectmode extended \
2194                 -font font_ui
2195         foreach h $all_heads {
2196                 if {$h ne $current_branch} {
2197                         $w.list.l insert end $h
2198                 }
2199         }
2200         pack $w.list.l -fill both -pady 5 -padx 5
2201         pack $w.list -fill both -pady 5 -padx 5
2202
2203         labelframe $w.validate \
2204                 -text {Delete Only If} \
2205                 -font font_ui
2206         radiobutton $w.validate.head_r \
2207                 -text {Merged Into Local Branch:} \
2208                 -value head \
2209                 -variable delete_branch_checktype \
2210                 -font font_ui
2211         eval tk_optionMenu $w.validate.head_m delete_branch_head $all_heads
2212         grid $w.validate.head_r $w.validate.head_m -sticky w
2213         set all_trackings [all_tracking_branches]
2214         if {$all_trackings ne {}} {
2215                 set delete_branch_trackinghead [lindex $all_trackings 0]
2216                 radiobutton $w.validate.tracking_r \
2217                         -text {Merged Into Tracking Branch:} \
2218                         -value tracking \
2219                         -variable delete_branch_checktype \
2220                         -font font_ui
2221                 eval tk_optionMenu $w.validate.tracking_m \
2222                         delete_branch_trackinghead \
2223                         $all_trackings
2224                 grid $w.validate.tracking_r $w.validate.tracking_m -sticky w
2225         }
2226         radiobutton $w.validate.always_r \
2227                 -text {Always (Do not perform merge checks)} \
2228                 -value always \
2229                 -variable delete_branch_checktype \
2230                 -font font_ui
2231         grid $w.validate.always_r -columnspan 2 -sticky w
2232         grid columnconfigure $w.validate 1 -weight 1
2233         pack $w.validate -anchor nw -fill x -pady 5 -padx 5
2234
2235         set delete_branch_head $current_branch
2236         set delete_branch_checktype head
2237
2238         bind $w <Visibility> "grab $w; focus $w"
2239         bind $w <Key-Escape> "destroy $w"
2240         wm title $w "[appname] ([reponame]): Delete Branch"
2241         tkwait window $w
2242 }
2243
2244 proc switch_branch {new_branch} {
2245         global HEAD commit_type current_branch repo_config
2246
2247         if {![lock_index switch]} return
2248
2249         # -- Our in memory state should match the repository.
2250         #
2251         repository_state curType curHEAD curMERGE_HEAD
2252         if {[string match amend* $commit_type]
2253                 && $curType eq {normal}
2254                 && $curHEAD eq $HEAD} {
2255         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
2256                 info_popup {Last scanned state does not match repository state.
2257
2258 Another Git program has modified this repository
2259 since the last scan.  A rescan must be performed
2260 before the current branch can be changed.
2261
2262 The rescan will be automatically started now.
2263 }
2264                 unlock_index
2265                 rescan {set ui_status_value {Ready.}}
2266                 return
2267         }
2268
2269         if {$repo_config(gui.trustmtime) eq {true}} {
2270                 switch_branch_stage2 {} $new_branch
2271         } else {
2272                 set ui_status_value {Refreshing file status...}
2273                 set cmd [list git update-index]
2274                 lappend cmd -q
2275                 lappend cmd --unmerged
2276                 lappend cmd --ignore-missing
2277                 lappend cmd --refresh
2278                 set fd_rf [open "| $cmd" r]
2279                 fconfigure $fd_rf -blocking 0 -translation binary
2280                 fileevent $fd_rf readable \
2281                         [list switch_branch_stage2 $fd_rf $new_branch]
2282         }
2283 }
2284
2285 proc switch_branch_stage2 {fd_rf new_branch} {
2286         global ui_status_value HEAD
2287
2288         if {$fd_rf ne {}} {
2289                 read $fd_rf
2290                 if {![eof $fd_rf]} return
2291                 close $fd_rf
2292         }
2293
2294         set ui_status_value "Updating working directory to '$new_branch'..."
2295         set cmd [list git read-tree]
2296         lappend cmd -m
2297         lappend cmd -u
2298         lappend cmd --exclude-per-directory=.gitignore
2299         lappend cmd $HEAD
2300         lappend cmd $new_branch
2301         set fd_rt [open "| $cmd" r]
2302         fconfigure $fd_rt -blocking 0 -translation binary
2303         fileevent $fd_rt readable \
2304                 [list switch_branch_readtree_wait $fd_rt $new_branch]
2305 }
2306
2307 proc switch_branch_readtree_wait {fd_rt new_branch} {
2308         global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2309         global current_branch
2310         global ui_comm ui_status_value
2311
2312         # -- We never get interesting output on stdout; only stderr.
2313         #
2314         read $fd_rt
2315         fconfigure $fd_rt -blocking 1
2316         if {![eof $fd_rt]} {
2317                 fconfigure $fd_rt -blocking 0
2318                 return
2319         }
2320
2321         # -- The working directory wasn't in sync with the index and
2322         #    we'd have to overwrite something to make the switch. A
2323         #    merge is required.
2324         #
2325         if {[catch {close $fd_rt} err]} {
2326                 regsub {^fatal: } $err {} err
2327                 warn_popup "File level merge required.
2328
2329 $err
2330
2331 Staying on branch '$current_branch'."
2332                 set ui_status_value "Aborted checkout of '$new_branch' (file level merging is required)."
2333                 unlock_index
2334                 return
2335         }
2336
2337         # -- Update the symbolic ref.  Core git doesn't even check for failure
2338         #    here, it Just Works(tm).  If it doesn't we are in some really ugly
2339         #    state that is difficult to recover from within git-gui.
2340         #
2341         if {[catch {exec git symbolic-ref HEAD "refs/heads/$new_branch"} err]} {
2342                 error_popup "Failed to set current branch.
2343
2344 This working directory is only partially switched.
2345 We successfully updated your files, but failed to
2346 update an internal Git file.
2347
2348 This should not have occurred.  [appname] will now
2349 close and give up.
2350
2351 $err"
2352                 do_quit
2353                 return
2354         }
2355
2356         # -- Update our repository state.  If we were previously in amend mode
2357         #    we need to toss the current buffer and do a full rescan to update
2358         #    our file lists.  If we weren't in amend mode our file lists are
2359         #    accurate and we can avoid the rescan.
2360         #
2361         unlock_index
2362         set selected_commit_type new
2363         if {[string match amend* $commit_type]} {
2364                 $ui_comm delete 0.0 end
2365                 $ui_comm edit reset
2366                 $ui_comm edit modified false
2367                 rescan {set ui_status_value "Checked out branch '$current_branch'."}
2368         } else {
2369                 repository_state commit_type HEAD MERGE_HEAD
2370                 set PARENT $HEAD
2371                 set ui_status_value "Checked out branch '$current_branch'."
2372         }
2373 }
2374
2375 ######################################################################
2376 ##
2377 ## remote management
2378
2379 proc load_all_remotes {} {
2380         global repo_config
2381         global all_remotes tracking_branches
2382
2383         set all_remotes [list]
2384         array unset tracking_branches
2385
2386         set rm_dir [gitdir remotes]
2387         if {[file isdirectory $rm_dir]} {
2388                 set all_remotes [glob \
2389                         -types f \
2390                         -tails \
2391                         -nocomplain \
2392                         -directory $rm_dir *]
2393
2394                 foreach name $all_remotes {
2395                         catch {
2396                                 set fd [open [file join $rm_dir $name] r]
2397                                 while {[gets $fd line] >= 0} {
2398                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
2399                                                 $line line src dst]} continue
2400                                         if {![regexp ^refs/ $dst]} {
2401                                                 set dst "refs/heads/$dst"
2402                                         }
2403                                         set tracking_branches($dst) [list $name $src]
2404                                 }
2405                                 close $fd
2406                         }
2407                 }
2408         }
2409
2410         foreach line [array names repo_config remote.*.url] {
2411                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
2412                 lappend all_remotes $name
2413
2414                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
2415                         set fl {}
2416                 }
2417                 foreach line $fl {
2418                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
2419                         if {![regexp ^refs/ $dst]} {
2420                                 set dst "refs/heads/$dst"
2421                         }
2422                         set tracking_branches($dst) [list $name $src]
2423                 }
2424         }
2425
2426         set all_remotes [lsort -unique $all_remotes]
2427 }
2428
2429 proc populate_fetch_menu {m} {
2430         global all_remotes repo_config
2431
2432         foreach r $all_remotes {
2433                 set enable 0
2434                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2435                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
2436                                 set enable 1
2437                         }
2438                 } else {
2439                         catch {
2440                                 set fd [open [gitdir remotes $r] r]
2441                                 while {[gets $fd n] >= 0} {
2442                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
2443                                                 set enable 1
2444                                                 break
2445                                         }
2446                                 }
2447                                 close $fd
2448                         }
2449                 }
2450
2451                 if {$enable} {
2452                         $m add command \
2453                                 -label "Fetch from $r..." \
2454                                 -command [list fetch_from $r] \
2455                                 -font font_ui
2456                 }
2457         }
2458 }
2459
2460 proc populate_push_menu {m} {
2461         global all_remotes repo_config
2462
2463         foreach r $all_remotes {
2464                 set enable 0
2465                 if {![catch {set a $repo_config(remote.$r.url)}]} {
2466                         if {![catch {set a $repo_config(remote.$r.push)}]} {
2467                                 set enable 1
2468                         }
2469                 } else {
2470                         catch {
2471                                 set fd [open [gitdir remotes $r] r]
2472                                 while {[gets $fd n] >= 0} {
2473                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
2474                                                 set enable 1
2475                                                 break
2476                                         }
2477                                 }
2478                                 close $fd
2479                         }
2480                 }
2481
2482                 if {$enable} {
2483                         $m add command \
2484                                 -label "Push to $r..." \
2485                                 -command [list push_to $r] \
2486                                 -font font_ui
2487                 }
2488         }
2489 }
2490
2491 proc populate_pull_menu {m} {
2492         global repo_config all_remotes disable_on_lock
2493
2494         foreach remote $all_remotes {
2495                 set rb_list [list]
2496                 if {[array get repo_config remote.$remote.url] ne {}} {
2497                         if {[array get repo_config remote.$remote.fetch] ne {}} {
2498                                 foreach line $repo_config(remote.$remote.fetch) {
2499                                         if {[regexp {^([^:]+):} $line line rb]} {
2500                                                 lappend rb_list $rb
2501                                         }
2502                                 }
2503                         }
2504                 } else {
2505                         catch {
2506                                 set fd [open [gitdir remotes $remote] r]
2507                                 while {[gets $fd line] >= 0} {
2508                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
2509                                                 lappend rb_list $rb
2510                                         }
2511                                 }
2512                                 close $fd
2513                         }
2514                 }
2515
2516                 foreach rb $rb_list {
2517                         regsub ^refs/heads/ $rb {} rb_short
2518                         $m add command \
2519                                 -label "Branch $rb_short from $remote..." \
2520                                 -command [list pull_remote $remote $rb] \
2521                                 -font font_ui
2522                         lappend disable_on_lock \
2523                                 [list $m entryconf [$m index last] -state]
2524                 }
2525         }
2526 }
2527
2528 ######################################################################
2529 ##
2530 ## icons
2531
2532 set filemask {
2533 #define mask_width 14
2534 #define mask_height 15
2535 static unsigned char mask_bits[] = {
2536    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2537    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2538    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2539 }
2540
2541 image create bitmap file_plain -background white -foreground black -data {
2542 #define plain_width 14
2543 #define plain_height 15
2544 static unsigned char plain_bits[] = {
2545    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2546    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2547    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2548 } -maskdata $filemask
2549
2550 image create bitmap file_mod -background white -foreground blue -data {
2551 #define mod_width 14
2552 #define mod_height 15
2553 static unsigned char mod_bits[] = {
2554    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2555    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2556    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2557 } -maskdata $filemask
2558
2559 image create bitmap file_fulltick -background white -foreground "#007000" -data {
2560 #define file_fulltick_width 14
2561 #define file_fulltick_height 15
2562 static unsigned char file_fulltick_bits[] = {
2563    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2564    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2565    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2566 } -maskdata $filemask
2567
2568 image create bitmap file_parttick -background white -foreground "#005050" -data {
2569 #define parttick_width 14
2570 #define parttick_height 15
2571 static unsigned char parttick_bits[] = {
2572    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2573    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2574    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2575 } -maskdata $filemask
2576
2577 image create bitmap file_question -background white -foreground black -data {
2578 #define file_question_width 14
2579 #define file_question_height 15
2580 static unsigned char file_question_bits[] = {
2581    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2582    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2583    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2584 } -maskdata $filemask
2585
2586 image create bitmap file_removed -background white -foreground red -data {
2587 #define file_removed_width 14
2588 #define file_removed_height 15
2589 static unsigned char file_removed_bits[] = {
2590    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2591    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2592    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2593 } -maskdata $filemask
2594
2595 image create bitmap file_merge -background white -foreground blue -data {
2596 #define file_merge_width 14
2597 #define file_merge_height 15
2598 static unsigned char file_merge_bits[] = {
2599    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2600    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2601    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2602 } -maskdata $filemask
2603
2604 set ui_index .vpane.files.index.list
2605 set ui_workdir .vpane.files.workdir.list
2606
2607 set all_icons(_$ui_index)   file_plain
2608 set all_icons(A$ui_index)   file_fulltick
2609 set all_icons(M$ui_index)   file_fulltick
2610 set all_icons(D$ui_index)   file_removed
2611 set all_icons(U$ui_index)   file_merge
2612
2613 set all_icons(_$ui_workdir) file_plain
2614 set all_icons(M$ui_workdir) file_mod
2615 set all_icons(D$ui_workdir) file_question
2616 set all_icons(U$ui_workdir) file_merge
2617 set all_icons(O$ui_workdir) file_plain
2618
2619 set max_status_desc 0
2620 foreach i {
2621                 {__ "Unmodified"}
2622
2623                 {_M "Modified, not staged"}
2624                 {M_ "Staged for commit"}
2625                 {MM "Portions staged for commit"}
2626                 {MD "Staged for commit, missing"}
2627
2628                 {_O "Untracked, not staged"}
2629                 {A_ "Staged for commit"}
2630                 {AM "Portions staged for commit"}
2631                 {AD "Staged for commit, missing"}
2632
2633                 {_D "Missing"}
2634                 {D_ "Staged for removal"}
2635                 {DO "Staged for removal, still present"}
2636
2637                 {U_ "Requires merge resolution"}
2638                 {UU "Requires merge resolution"}
2639                 {UM "Requires merge resolution"}
2640                 {UD "Requires merge resolution"}
2641         } {
2642         if {$max_status_desc < [string length [lindex $i 1]]} {
2643                 set max_status_desc [string length [lindex $i 1]]
2644         }
2645         set all_descs([lindex $i 0]) [lindex $i 1]
2646 }
2647 unset i
2648
2649 ######################################################################
2650 ##
2651 ## util
2652
2653 proc is_MacOSX {} {
2654         global tcl_platform tk_library
2655         if {[tk windowingsystem] eq {aqua}} {
2656                 return 1
2657         }
2658         return 0
2659 }
2660
2661 proc is_Windows {} {
2662         global tcl_platform
2663         if {$tcl_platform(platform) eq {windows}} {
2664                 return 1
2665         }
2666         return 0
2667 }
2668
2669 proc bind_button3 {w cmd} {
2670         bind $w <Any-Button-3> $cmd
2671         if {[is_MacOSX]} {
2672                 bind $w <Control-Button-1> $cmd
2673         }
2674 }
2675
2676 proc incr_font_size {font {amt 1}} {
2677         set sz [font configure $font -size]
2678         incr sz $amt
2679         font configure $font -size $sz
2680         font configure ${font}bold -size $sz
2681 }
2682
2683 proc hook_failed_popup {hook msg} {
2684         set w .hookfail
2685         toplevel $w
2686
2687         frame $w.m
2688         label $w.m.l1 -text "$hook hook failed:" \
2689                 -anchor w \
2690                 -justify left \
2691                 -font font_uibold
2692         text $w.m.t \
2693                 -background white -borderwidth 1 \
2694                 -relief sunken \
2695                 -width 80 -height 10 \
2696                 -font font_diff \
2697                 -yscrollcommand [list $w.m.sby set]
2698         label $w.m.l2 \
2699                 -text {You must correct the above errors before committing.} \
2700                 -anchor w \
2701                 -justify left \
2702                 -font font_uibold
2703         scrollbar $w.m.sby -command [list $w.m.t yview]
2704         pack $w.m.l1 -side top -fill x
2705         pack $w.m.l2 -side bottom -fill x
2706         pack $w.m.sby -side right -fill y
2707         pack $w.m.t -side left -fill both -expand 1
2708         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2709
2710         $w.m.t insert 1.0 $msg
2711         $w.m.t conf -state disabled
2712
2713         button $w.ok -text OK \
2714                 -width 15 \
2715                 -font font_ui \
2716                 -command "destroy $w"
2717         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2718
2719         bind $w <Visibility> "grab $w; focus $w"
2720         bind $w <Key-Return> "destroy $w"
2721         wm title $w "[appname] ([reponame]): error"
2722         tkwait window $w
2723 }
2724
2725 set next_console_id 0
2726
2727 proc new_console {short_title long_title} {
2728         global next_console_id console_data
2729         set w .console[incr next_console_id]
2730         set console_data($w) [list $short_title $long_title]
2731         return [console_init $w]
2732 }
2733
2734 proc console_init {w} {
2735         global console_cr console_data M1B
2736
2737         set console_cr($w) 1.0
2738         toplevel $w
2739         frame $w.m
2740         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2741                 -anchor w \
2742                 -justify left \
2743                 -font font_uibold
2744         text $w.m.t \
2745                 -background white -borderwidth 1 \
2746                 -relief sunken \
2747                 -width 80 -height 10 \
2748                 -font font_diff \
2749                 -state disabled \
2750                 -yscrollcommand [list $w.m.sby set]
2751         label $w.m.s -text {Working... please wait...} \
2752                 -anchor w \
2753                 -justify left \
2754                 -font font_uibold
2755         scrollbar $w.m.sby -command [list $w.m.t yview]
2756         pack $w.m.l1 -side top -fill x
2757         pack $w.m.s -side bottom -fill x
2758         pack $w.m.sby -side right -fill y
2759         pack $w.m.t -side left -fill both -expand 1
2760         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2761
2762         menu $w.ctxm -tearoff 0
2763         $w.ctxm add command -label "Copy" \
2764                 -font font_ui \
2765                 -command "tk_textCopy $w.m.t"
2766         $w.ctxm add command -label "Select All" \
2767                 -font font_ui \
2768                 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2769         $w.ctxm add command -label "Copy All" \
2770                 -font font_ui \
2771                 -command "
2772                         $w.m.t tag add sel 0.0 end
2773                         tk_textCopy $w.m.t
2774                         $w.m.t tag remove sel 0.0 end
2775                 "
2776
2777         button $w.ok -text {Close} \
2778                 -font font_ui \
2779                 -state disabled \
2780                 -command "destroy $w"
2781         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2782
2783         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2784         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2785         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2786         bind $w <Visibility> "focus $w"
2787         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2788         return $w
2789 }
2790
2791 proc console_exec {w cmd {after {}}} {
2792         # -- Windows tosses the enviroment when we exec our child.
2793         #    But most users need that so we have to relogin. :-(
2794         #
2795         if {[is_Windows]} {
2796                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2797         }
2798
2799         # -- Tcl won't let us redirect both stdout and stderr to
2800         #    the same pipe.  So pass it through cat...
2801         #
2802         set cmd [concat | $cmd |& cat]
2803
2804         set fd_f [open $cmd r]
2805         fconfigure $fd_f -blocking 0 -translation binary
2806         fileevent $fd_f readable [list console_read $w $fd_f $after]
2807 }
2808
2809 proc console_read {w fd after} {
2810         global console_cr console_data
2811
2812         set buf [read $fd]
2813         if {$buf ne {}} {
2814                 if {![winfo exists $w]} {console_init $w}
2815                 $w.m.t conf -state normal
2816                 set c 0
2817                 set n [string length $buf]
2818                 while {$c < $n} {
2819                         set cr [string first "\r" $buf $c]
2820                         set lf [string first "\n" $buf $c]
2821                         if {$cr < 0} {set cr [expr {$n + 1}]}
2822                         if {$lf < 0} {set lf [expr {$n + 1}]}
2823
2824                         if {$lf < $cr} {
2825                                 $w.m.t insert end [string range $buf $c $lf]
2826                                 set console_cr($w) [$w.m.t index {end -1c}]
2827                                 set c $lf
2828                                 incr c
2829                         } else {
2830                                 $w.m.t delete $console_cr($w) end
2831                                 $w.m.t insert end "\n"
2832                                 $w.m.t insert end [string range $buf $c $cr]
2833                                 set c $cr
2834                                 incr c
2835                         }
2836                 }
2837                 $w.m.t conf -state disabled
2838                 $w.m.t see end
2839         }
2840
2841         fconfigure $fd -blocking 1
2842         if {[eof $fd]} {
2843                 if {[catch {close $fd}]} {
2844                         if {![winfo exists $w]} {console_init $w}
2845                         $w.m.s conf -background red -text {Error: Command Failed}
2846                         $w.ok conf -state normal
2847                         set ok 0
2848                 } elseif {[winfo exists $w]} {
2849                         $w.m.s conf -background green -text {Success}
2850                         $w.ok conf -state normal
2851                         set ok 1
2852                 }
2853                 array unset console_cr $w
2854                 array unset console_data $w
2855                 if {$after ne {}} {
2856                         uplevel #0 $after $ok
2857                 }
2858                 return
2859         }
2860         fconfigure $fd -blocking 0
2861 }
2862
2863 ######################################################################
2864 ##
2865 ## ui commands
2866
2867 set starting_gitk_msg {Starting gitk... please wait...}
2868
2869 proc do_gitk {revs} {
2870         global ui_status_value starting_gitk_msg
2871
2872         set cmd gitk
2873         if {$revs ne {}} {
2874                 append cmd { }
2875                 append cmd $revs
2876         }
2877         if {[is_Windows]} {
2878                 set cmd "sh -c \"exec $cmd\""
2879         }
2880         append cmd { &}
2881
2882         if {[catch {eval exec $cmd} err]} {
2883                 error_popup "Failed to start gitk:\n\n$err"
2884         } else {
2885                 set ui_status_value $starting_gitk_msg
2886                 after 10000 {
2887                         if {$ui_status_value eq $starting_gitk_msg} {
2888                                 set ui_status_value {Ready.}
2889                         }
2890                 }
2891         }
2892 }
2893
2894 proc do_stats {} {
2895         set fd [open "| git count-objects -v" r]
2896         while {[gets $fd line] > 0} {
2897                 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
2898                         set stats($name) $value
2899                 }
2900         }
2901         close $fd
2902
2903         set packed_sz 0
2904         foreach p [glob -directory [gitdir objects pack] \
2905                 -type f \
2906                 -nocomplain -- *] {
2907                 incr packed_sz [file size $p]
2908         }
2909         if {$packed_sz > 0} {
2910                 set stats(size-pack) [expr {$packed_sz / 1024}]
2911         }
2912
2913         set w .stats_view
2914         toplevel $w
2915         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2916
2917         label $w.header -text {Database Statistics} \
2918                 -font font_uibold
2919         pack $w.header -side top -fill x
2920
2921         frame $w.buttons -border 1
2922         button $w.buttons.close -text Close \
2923                 -font font_ui \
2924                 -command [list destroy $w]
2925         button $w.buttons.gc -text {Compress Database} \
2926                 -font font_ui \
2927                 -command "destroy $w;do_gc"
2928         pack $w.buttons.close -side right
2929         pack $w.buttons.gc -side left
2930         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2931
2932         frame $w.stat -borderwidth 1 -relief solid
2933         foreach s {
2934                 {count           {Number of loose objects}}
2935                 {size            {Disk space used by loose objects} { KiB}}
2936                 {in-pack         {Number of packed objects}}
2937                 {packs           {Number of packs}}
2938                 {size-pack       {Disk space used by packed objects} { KiB}}
2939                 {prune-packable  {Packed objects waiting for pruning}}
2940                 {garbage         {Garbage files}}
2941                 } {
2942                 set name [lindex $s 0]
2943                 set label [lindex $s 1]
2944                 if {[catch {set value $stats($name)}]} continue
2945                 if {[llength $s] > 2} {
2946                         set value "$value[lindex $s 2]"
2947                 }
2948
2949                 label $w.stat.l_$name -text "$label:" -anchor w -font font_ui
2950                 label $w.stat.v_$name -text $value -anchor w -font font_ui
2951                 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
2952         }
2953         pack $w.stat -pady 10 -padx 10
2954
2955         bind $w <Visibility> "grab $w; focus $w"
2956         bind $w <Key-Escape> [list destroy $w]
2957         bind $w <Key-Return> [list destroy $w]
2958         wm title $w "[appname] ([reponame]): Database Statistics"
2959         tkwait window $w
2960 }
2961
2962 proc do_gc {} {
2963         set w [new_console {gc} {Compressing the object database}]
2964         console_exec $w {git gc}
2965 }
2966
2967 proc do_fsck_objects {} {
2968         set w [new_console {fsck-objects} \
2969                 {Verifying the object database with fsck-objects}]
2970         set cmd [list git fsck-objects]
2971         lappend cmd --full
2972         lappend cmd --cache
2973         lappend cmd --strict
2974         console_exec $w $cmd
2975 }
2976
2977 set is_quitting 0
2978
2979 proc do_quit {} {
2980         global ui_comm is_quitting repo_config commit_type
2981
2982         if {$is_quitting} return
2983         set is_quitting 1
2984
2985         # -- Stash our current commit buffer.
2986         #
2987         set save [gitdir GITGUI_MSG]
2988         set msg [string trim [$ui_comm get 0.0 end]]
2989         regsub -all -line {[ \r\t]+$} $msg {} msg
2990         if {(![string match amend* $commit_type]
2991                 || [$ui_comm edit modified])
2992                 && $msg ne {}} {
2993                 catch {
2994                         set fd [open $save w]
2995                         puts -nonewline $fd $msg
2996                         close $fd
2997                 }
2998         } else {
2999                 catch {file delete $save}
3000         }
3001
3002         # -- Stash our current window geometry into this repository.
3003         #
3004         set cfg_geometry [list]
3005         lappend cfg_geometry [wm geometry .]
3006         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
3007         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
3008         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
3009                 set rc_geometry {}
3010         }
3011         if {$cfg_geometry ne $rc_geometry} {
3012                 catch {exec git repo-config gui.geometry $cfg_geometry}
3013         }
3014
3015         destroy .
3016 }
3017
3018 proc do_rescan {} {
3019         rescan {set ui_status_value {Ready.}}
3020 }
3021
3022 proc unstage_helper {txt paths} {
3023         global file_states current_diff_path
3024
3025         if {![lock_index begin-update]} return
3026
3027         set pathList [list]
3028         set after {}
3029         foreach path $paths {
3030                 switch -glob -- [lindex $file_states($path) 0] {
3031                 A? -
3032                 M? -
3033                 D? {
3034                         lappend pathList $path
3035                         if {$path eq $current_diff_path} {
3036                                 set after {reshow_diff;}
3037                         }
3038                 }
3039                 }
3040         }
3041         if {$pathList eq {}} {
3042                 unlock_index
3043         } else {
3044                 update_indexinfo \
3045                         $txt \
3046                         $pathList \
3047                         [concat $after {set ui_status_value {Ready.}}]
3048         }
3049 }
3050
3051 proc do_unstage_selection {} {
3052         global current_diff_path selected_paths
3053
3054         if {[array size selected_paths] > 0} {
3055                 unstage_helper \
3056                         {Unstaging selected files from commit} \
3057                         [array names selected_paths]
3058         } elseif {$current_diff_path ne {}} {
3059                 unstage_helper \
3060                         "Unstaging [short_path $current_diff_path] from commit" \
3061                         [list $current_diff_path]
3062         }
3063 }
3064
3065 proc add_helper {txt paths} {
3066         global file_states current_diff_path
3067
3068         if {![lock_index begin-update]} return
3069
3070         set pathList [list]
3071         set after {}
3072         foreach path $paths {
3073                 switch -glob -- [lindex $file_states($path) 0] {
3074                 _O -
3075                 ?M -
3076                 ?D -
3077                 U? {
3078                         lappend pathList $path
3079                         if {$path eq $current_diff_path} {
3080                                 set after {reshow_diff;}
3081                         }
3082                 }
3083                 }
3084         }
3085         if {$pathList eq {}} {
3086                 unlock_index
3087         } else {
3088                 update_index \
3089                         $txt \
3090                         $pathList \
3091                         [concat $after {set ui_status_value {Ready to commit.}}]
3092         }
3093 }
3094
3095 proc do_add_selection {} {
3096         global current_diff_path selected_paths
3097
3098         if {[array size selected_paths] > 0} {
3099                 add_helper \
3100                         {Adding selected files} \
3101                         [array names selected_paths]
3102         } elseif {$current_diff_path ne {}} {
3103                 add_helper \
3104                         "Adding [short_path $current_diff_path]" \
3105                         [list $current_diff_path]
3106         }
3107 }
3108
3109 proc do_add_all {} {
3110         global file_states
3111
3112         set paths [list]
3113         foreach path [array names file_states] {
3114                 switch -glob -- [lindex $file_states($path) 0] {
3115                 U? {continue}
3116                 ?M -
3117                 ?D {lappend paths $path}
3118                 }
3119         }
3120         add_helper {Adding all changed files} $paths
3121 }
3122
3123 proc revert_helper {txt paths} {
3124         global file_states current_diff_path
3125
3126         if {![lock_index begin-update]} return
3127
3128         set pathList [list]
3129         set after {}
3130         foreach path $paths {
3131                 switch -glob -- [lindex $file_states($path) 0] {
3132                 U? {continue}
3133                 ?M -
3134                 ?D {
3135                         lappend pathList $path
3136                         if {$path eq $current_diff_path} {
3137                                 set after {reshow_diff;}
3138                         }
3139                 }
3140                 }
3141         }
3142
3143         set n [llength $pathList]
3144         if {$n == 0} {
3145                 unlock_index
3146                 return
3147         } elseif {$n == 1} {
3148                 set s "[short_path [lindex $pathList]]"
3149         } else {
3150                 set s "these $n files"
3151         }
3152
3153         set reply [tk_dialog \
3154                 .confirm_revert \
3155                 "[appname] ([reponame])" \
3156                 "Revert changes in $s?
3157
3158 Any unadded changes will be permanently lost by the revert." \
3159                 question \
3160                 1 \
3161                 {Do Nothing} \
3162                 {Revert Changes} \
3163                 ]
3164         if {$reply == 1} {
3165                 checkout_index \
3166                         $txt \
3167                         $pathList \
3168                         [concat $after {set ui_status_value {Ready.}}]
3169         } else {
3170                 unlock_index
3171         }
3172 }
3173
3174 proc do_revert_selection {} {
3175         global current_diff_path selected_paths
3176
3177         if {[array size selected_paths] > 0} {
3178                 revert_helper \
3179                         {Reverting selected files} \
3180                         [array names selected_paths]
3181         } elseif {$current_diff_path ne {}} {
3182                 revert_helper \
3183                         "Reverting [short_path $current_diff_path]" \
3184                         [list $current_diff_path]
3185         }
3186 }
3187
3188 proc do_signoff {} {
3189         global ui_comm
3190
3191         set me [committer_ident]
3192         if {$me eq {}} return
3193
3194         set sob "Signed-off-by: $me"
3195         set last [$ui_comm get {end -1c linestart} {end -1c}]
3196         if {$last ne $sob} {
3197                 $ui_comm edit separator
3198                 if {$last ne {}
3199                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
3200                         $ui_comm insert end "\n"
3201                 }
3202                 $ui_comm insert end "\n$sob"
3203                 $ui_comm edit separator
3204                 $ui_comm see end
3205         }
3206 }
3207
3208 proc do_select_commit_type {} {
3209         global commit_type selected_commit_type
3210
3211         if {$selected_commit_type eq {new}
3212                 && [string match amend* $commit_type]} {
3213                 create_new_commit
3214         } elseif {$selected_commit_type eq {amend}
3215                 && ![string match amend* $commit_type]} {
3216                 load_last_commit
3217
3218                 # The amend request was rejected...
3219                 #
3220                 if {![string match amend* $commit_type]} {
3221                         set selected_commit_type new
3222                 }
3223         }
3224 }
3225
3226 proc do_commit {} {
3227         commit_tree
3228 }
3229
3230 proc do_about {} {
3231         global appvers copyright
3232         global tcl_patchLevel tk_patchLevel
3233
3234         set w .about_dialog
3235         toplevel $w
3236         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3237
3238         label $w.header -text "About [appname]" \
3239                 -font font_uibold
3240         pack $w.header -side top -fill x
3241
3242         frame $w.buttons
3243         button $w.buttons.close -text {Close} \
3244                 -font font_ui \
3245                 -command [list destroy $w]
3246         pack $w.buttons.close -side right
3247         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3248
3249         label $w.desc \
3250                 -text "[appname] - a commit creation tool for Git.
3251 $copyright" \
3252                 -padx 5 -pady 5 \
3253                 -justify left \
3254                 -anchor w \
3255                 -borderwidth 1 \
3256                 -relief solid \
3257                 -font font_ui
3258         pack $w.desc -side top -fill x -padx 5 -pady 5
3259
3260         set v {}
3261         append v "[appname] version $appvers\n"
3262         append v "[exec git version]\n"
3263         append v "\n"
3264         if {$tcl_patchLevel eq $tk_patchLevel} {
3265                 append v "Tcl/Tk version $tcl_patchLevel"
3266         } else {
3267                 append v "Tcl version $tcl_patchLevel"
3268                 append v ", Tk version $tk_patchLevel"
3269         }
3270
3271         label $w.vers \
3272                 -text $v \
3273                 -padx 5 -pady 5 \
3274                 -justify left \
3275                 -anchor w \
3276                 -borderwidth 1 \
3277                 -relief solid \
3278                 -font font_ui
3279         pack $w.vers -side top -fill x -padx 5 -pady 5
3280
3281         menu $w.ctxm -tearoff 0
3282         $w.ctxm add command \
3283                 -label {Copy} \
3284                 -font font_ui \
3285                 -command "
3286                 clipboard clear
3287                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3288         "
3289
3290         bind $w <Visibility> "grab $w; focus $w"
3291         bind $w <Key-Escape> "destroy $w"
3292         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3293         wm title $w "About [appname]"
3294         tkwait window $w
3295 }
3296
3297 proc do_options {} {
3298         global repo_config global_config font_descs
3299         global repo_config_new global_config_new
3300
3301         array unset repo_config_new
3302         array unset global_config_new
3303         foreach name [array names repo_config] {
3304                 set repo_config_new($name) $repo_config($name)
3305         }
3306         load_config 1
3307         foreach name [array names repo_config] {
3308                 switch -- $name {
3309                 gui.diffcontext {continue}
3310                 }
3311                 set repo_config_new($name) $repo_config($name)
3312         }
3313         foreach name [array names global_config] {
3314                 set global_config_new($name) $global_config($name)
3315         }
3316
3317         set w .options_editor
3318         toplevel $w
3319         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
3320
3321         label $w.header -text "[appname] Options" \
3322                 -font font_uibold
3323         pack $w.header -side top -fill x
3324
3325         frame $w.buttons
3326         button $w.buttons.restore -text {Restore Defaults} \
3327                 -font font_ui \
3328                 -command do_restore_defaults
3329         pack $w.buttons.restore -side left
3330         button $w.buttons.save -text Save \
3331                 -font font_ui \
3332                 -command "
3333                         catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3334                         do_save_config $w
3335                 "
3336         pack $w.buttons.save -side right
3337         button $w.buttons.cancel -text {Cancel} \
3338                 -font font_ui \
3339                 -command [list destroy $w]
3340         pack $w.buttons.cancel -side right -padx 5
3341         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
3342
3343         labelframe $w.repo -text "[reponame] Repository" \
3344                 -font font_ui
3345         labelframe $w.global -text {Global (All Repositories)} \
3346                 -font font_ui
3347         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
3348         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
3349
3350         foreach option {
3351                 {b pullsummary {Show Pull Summary}}
3352                 {b trustmtime  {Trust File Modification Timestamps}}
3353                 {i diffcontext {Number of Diff Context Lines}}
3354                 {t newbranchtemplate {New Branch Name Template}}
3355                 } {
3356                 set type [lindex $option 0]
3357                 set name [lindex $option 1]
3358                 set text [lindex $option 2]
3359                 foreach f {repo global} {
3360                         switch $type {
3361                         b {
3362                                 checkbutton $w.$f.$name -text $text \
3363                                         -variable ${f}_config_new(gui.$name) \
3364                                         -onvalue true \
3365                                         -offvalue false \
3366                                         -font font_ui
3367                                 pack $w.$f.$name -side top -anchor w
3368                         }
3369                         i {
3370                                 frame $w.$f.$name
3371                                 label $w.$f.$name.l -text "$text:" -font font_ui
3372                                 pack $w.$f.$name.l -side left -anchor w -fill x
3373                                 spinbox $w.$f.$name.v \
3374                                         -textvariable ${f}_config_new(gui.$name) \
3375                                         -from 1 -to 99 -increment 1 \
3376                                         -width 3 \
3377                                         -font font_ui
3378                                 bind $w.$f.$name.v <FocusIn> {%W selection range 0 end}
3379                                 pack $w.$f.$name.v -side right -anchor e -padx 5
3380                                 pack $w.$f.$name -side top -anchor w -fill x
3381                         }
3382                         t {
3383                                 frame $w.$f.$name
3384                                 label $w.$f.$name.l -text "$text:" -font font_ui
3385                                 text $w.$f.$name.v \
3386                                         -borderwidth 1 \
3387                                         -relief sunken \
3388                                         -height 1 \
3389                                         -width 20 \
3390                                         -font font_ui
3391                                 $w.$f.$name.v insert 0.0 [set ${f}_config_new(gui.$name)]
3392                                 bind $w.$f.$name.v <Shift-Key-Tab> {focus [tk_focusPrev %W];break}
3393                                 bind $w.$f.$name.v <Key-Tab> {focus [tk_focusNext %W];break}
3394                                 bind $w.$f.$name.v <Key-Return> break
3395                                 bind $w.$f.$name.v <FocusIn> "$w.$f.$name.v tag add sel 0.0 end"
3396                                 bind $w.$f.$name.v <FocusOut> "
3397                                         set ${f}_config_new(gui.$name) \
3398                                         \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3399                                 "
3400                                 pack $w.$f.$name.l -side left -anchor w
3401                                 pack $w.$f.$name.v -side left -anchor w \
3402                                         -fill x -expand 1 \
3403                                         -padx 5
3404                                 pack $w.$f.$name -side top -anchor w -fill x
3405                         }
3406                         }
3407                 }
3408         }
3409
3410         set all_fonts [lsort [font families]]
3411         foreach option $font_descs {
3412                 set name [lindex $option 0]
3413                 set font [lindex $option 1]
3414                 set text [lindex $option 2]
3415
3416                 set global_config_new(gui.$font^^family) \
3417                         [font configure $font -family]
3418                 set global_config_new(gui.$font^^size) \
3419                         [font configure $font -size]
3420
3421                 frame $w.global.$name
3422                 label $w.global.$name.l -text "$text:" -font font_ui
3423                 pack $w.global.$name.l -side left -anchor w -fill x
3424                 eval tk_optionMenu $w.global.$name.family \
3425                         global_config_new(gui.$font^^family) \
3426                         $all_fonts
3427                 spinbox $w.global.$name.size \
3428                         -textvariable global_config_new(gui.$font^^size) \
3429                         -from 2 -to 80 -increment 1 \
3430                         -width 3 \
3431                         -font font_ui
3432                 bind $w.global.$name.size <FocusIn> {%W selection range 0 end}
3433                 pack $w.global.$name.size -side right -anchor e
3434                 pack $w.global.$name.family -side right -anchor e
3435                 pack $w.global.$name -side top -anchor w -fill x
3436         }
3437
3438         bind $w <Visibility> "grab $w; focus $w"
3439         bind $w <Key-Escape> "destroy $w"
3440         wm title $w "[appname] ([reponame]): Options"
3441         tkwait window $w
3442 }
3443
3444 proc do_restore_defaults {} {
3445         global font_descs default_config repo_config
3446         global repo_config_new global_config_new
3447
3448         foreach name [array names default_config] {
3449                 set repo_config_new($name) $default_config($name)
3450                 set global_config_new($name) $default_config($name)
3451         }
3452
3453         foreach option $font_descs {
3454                 set name [lindex $option 0]
3455                 set repo_config(gui.$name) $default_config(gui.$name)
3456         }
3457         apply_config
3458
3459         foreach option $font_descs {
3460                 set name [lindex $option 0]
3461                 set font [lindex $option 1]
3462                 set global_config_new(gui.$font^^family) \
3463                         [font configure $font -family]
3464                 set global_config_new(gui.$font^^size) \
3465                         [font configure $font -size]
3466         }
3467 }
3468
3469 proc do_save_config {w} {
3470         if {[catch {save_config} err]} {
3471                 error_popup "Failed to completely save options:\n\n$err"
3472         }
3473         reshow_diff
3474         destroy $w
3475 }
3476
3477 proc do_windows_shortcut {} {
3478         global argv0
3479
3480         if {[catch {
3481                 set desktop [exec cygpath \
3482                         --windows \
3483                         --absolute \
3484                         --long-name \
3485                         --desktop]
3486                 }]} {
3487                         set desktop .
3488         }
3489         set fn [tk_getSaveFile \
3490                 -parent . \
3491                 -title "[appname] ([reponame]): Create Desktop Icon" \
3492                 -initialdir $desktop \
3493                 -initialfile "Git [reponame].bat"]
3494         if {$fn != {}} {
3495                 if {[catch {
3496                                 set fd [open $fn w]
3497                                 set sh [exec cygpath \
3498                                         --windows \
3499                                         --absolute \
3500                                         /bin/sh]
3501                                 set me [exec cygpath \
3502                                         --unix \
3503                                         --absolute \
3504                                         $argv0]
3505                                 set gd [exec cygpath \
3506                                         --unix \
3507                                         --absolute \
3508                                         [gitdir]]
3509                                 set gw [exec cygpath \
3510                                         --windows \
3511                                         --absolute \
3512                                         [file dirname [gitdir]]]
3513                                 regsub -all ' $me "'\\''" me
3514                                 regsub -all ' $gd "'\\''" gd
3515                                 puts $fd "@ECHO Entering $gw"
3516                                 puts $fd "@ECHO Starting git-gui... please wait..."
3517                                 puts -nonewline $fd "@\"$sh\" --login -c \""
3518                                 puts -nonewline $fd "GIT_DIR='$gd'"
3519                                 puts -nonewline $fd " '$me'"
3520                                 puts $fd "&\""
3521                                 close $fd
3522                         } err]} {
3523                         error_popup "Cannot write script:\n\n$err"
3524                 }
3525         }
3526 }
3527
3528 proc do_macosx_app {} {
3529         global argv0 env
3530
3531         set fn [tk_getSaveFile \
3532                 -parent . \
3533                 -title "[appname] ([reponame]): Create Desktop Icon" \
3534                 -initialdir [file join $env(HOME) Desktop] \
3535                 -initialfile "Git [reponame].app"]
3536         if {$fn != {}} {
3537                 if {[catch {
3538                                 set Contents [file join $fn Contents]
3539                                 set MacOS [file join $Contents MacOS]
3540                                 set exe [file join $MacOS git-gui]
3541
3542                                 file mkdir $MacOS
3543
3544                                 set fd [open [file join $Contents Info.plist] w]
3545                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3546 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3547 <plist version="1.0">
3548 <dict>
3549         <key>CFBundleDevelopmentRegion</key>
3550         <string>English</string>
3551         <key>CFBundleExecutable</key>
3552         <string>git-gui</string>
3553         <key>CFBundleIdentifier</key>
3554         <string>org.spearce.git-gui</string>
3555         <key>CFBundleInfoDictionaryVersion</key>
3556         <string>6.0</string>
3557         <key>CFBundlePackageType</key>
3558         <string>APPL</string>
3559         <key>CFBundleSignature</key>
3560         <string>????</string>
3561         <key>CFBundleVersion</key>
3562         <string>1.0</string>
3563         <key>NSPrincipalClass</key>
3564         <string>NSApplication</string>
3565 </dict>
3566 </plist>}
3567                                 close $fd
3568
3569                                 set fd [open $exe w]
3570                                 set gd [file normalize [gitdir]]
3571                                 set ep [file normalize [exec git --exec-path]]
3572                                 regsub -all ' $gd "'\\''" gd
3573                                 regsub -all ' $ep "'\\''" ep
3574                                 puts $fd "#!/bin/sh"
3575                                 foreach name [array names env] {
3576                                         if {[string match GIT_* $name]} {
3577                                                 regsub -all ' $env($name) "'\\''" v
3578                                                 puts $fd "export $name='$v'"
3579                                         }
3580                                 }
3581                                 puts $fd "export PATH='$ep':\$PATH"
3582                                 puts $fd "export GIT_DIR='$gd'"
3583                                 puts $fd "exec [file normalize $argv0]"
3584                                 close $fd
3585
3586                                 file attributes $exe -permissions u+x,g+x,o+x
3587                         } err]} {
3588                         error_popup "Cannot write icon:\n\n$err"
3589                 }
3590         }
3591 }
3592
3593 proc toggle_or_diff {w x y} {
3594         global file_states file_lists current_diff_path ui_index ui_workdir
3595         global last_clicked selected_paths
3596
3597         set pos [split [$w index @$x,$y] .]
3598         set lno [lindex $pos 0]
3599         set col [lindex $pos 1]
3600         set path [lindex $file_lists($w) [expr {$lno - 1}]]
3601         if {$path eq {}} {
3602                 set last_clicked {}
3603                 return
3604         }
3605
3606         set last_clicked [list $w $lno]
3607         array unset selected_paths
3608         $ui_index tag remove in_sel 0.0 end
3609         $ui_workdir tag remove in_sel 0.0 end
3610
3611         if {$col == 0} {
3612                 if {$current_diff_path eq $path} {
3613                         set after {reshow_diff;}
3614                 } else {
3615                         set after {}
3616                 }
3617                 if {$w eq $ui_index} {
3618                         update_indexinfo \
3619                                 "Unstaging [short_path $path] from commit" \
3620                                 [list $path] \
3621                                 [concat $after {set ui_status_value {Ready.}}]
3622                 } elseif {$w eq $ui_workdir} {
3623                         update_index \
3624                                 "Adding [short_path $path]" \
3625                                 [list $path] \
3626                                 [concat $after {set ui_status_value {Ready.}}]
3627                 }
3628         } else {
3629                 show_diff $path $w $lno
3630         }
3631 }
3632
3633 proc add_one_to_selection {w x y} {
3634         global file_lists last_clicked selected_paths
3635
3636         set lno [lindex [split [$w index @$x,$y] .] 0]
3637         set path [lindex $file_lists($w) [expr {$lno - 1}]]
3638         if {$path eq {}} {
3639                 set last_clicked {}
3640                 return
3641         }
3642
3643         if {$last_clicked ne {}
3644                 && [lindex $last_clicked 0] ne $w} {
3645                 array unset selected_paths
3646                 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3647         }
3648
3649         set last_clicked [list $w $lno]
3650         if {[catch {set in_sel $selected_paths($path)}]} {
3651                 set in_sel 0
3652         }
3653         if {$in_sel} {
3654                 unset selected_paths($path)
3655                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3656         } else {
3657                 set selected_paths($path) 1
3658                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3659         }
3660 }
3661
3662 proc add_range_to_selection {w x y} {
3663         global file_lists last_clicked selected_paths
3664
3665         if {[lindex $last_clicked 0] ne $w} {
3666                 toggle_or_diff $w $x $y
3667                 return
3668         }
3669
3670         set lno [lindex [split [$w index @$x,$y] .] 0]
3671         set lc [lindex $last_clicked 1]
3672         if {$lc < $lno} {
3673                 set begin $lc
3674                 set end $lno
3675         } else {
3676                 set begin $lno
3677                 set end $lc
3678         }
3679
3680         foreach path [lrange $file_lists($w) \
3681                 [expr {$begin - 1}] \
3682                 [expr {$end - 1}]] {
3683                 set selected_paths($path) 1
3684         }
3685         $w tag add in_sel $begin.0 [expr {$end + 1}].0
3686 }
3687
3688 ######################################################################
3689 ##
3690 ## config defaults
3691
3692 set cursor_ptr arrow
3693 font create font_diff -family Courier -size 10
3694 font create font_ui
3695 catch {
3696         label .dummy
3697         eval font configure font_ui [font actual [.dummy cget -font]]
3698         destroy .dummy
3699 }
3700
3701 font create font_uibold
3702 font create font_diffbold
3703
3704 if {[is_Windows]} {
3705         set M1B Control
3706         set M1T Ctrl
3707 } elseif {[is_MacOSX]} {
3708         set M1B M1
3709         set M1T Cmd
3710 } else {
3711         set M1B M1
3712         set M1T M1
3713 }
3714
3715 proc apply_config {} {
3716         global repo_config font_descs
3717
3718         foreach option $font_descs {
3719                 set name [lindex $option 0]
3720                 set font [lindex $option 1]
3721                 if {[catch {
3722                         foreach {cn cv} $repo_config(gui.$name) {
3723                                 font configure $font $cn $cv
3724                         }
3725                         } err]} {
3726                         error_popup "Invalid font specified in gui.$name:\n\n$err"
3727                 }
3728                 foreach {cn cv} [font configure $font] {
3729                         font configure ${font}bold $cn $cv
3730                 }
3731                 font configure ${font}bold -weight bold
3732         }
3733 }
3734
3735 set default_config(gui.trustmtime) false
3736 set default_config(gui.pullsummary) true
3737 set default_config(gui.diffcontext) 5
3738 set default_config(gui.newbranchtemplate) {}
3739 set default_config(gui.fontui) [font configure font_ui]
3740 set default_config(gui.fontdiff) [font configure font_diff]
3741 set font_descs {
3742         {fontui   font_ui   {Main Font}}
3743         {fontdiff font_diff {Diff/Console Font}}
3744 }
3745 load_config 0
3746 apply_config
3747
3748 ######################################################################
3749 ##
3750 ## ui construction
3751
3752 # -- Menu Bar
3753 #
3754 menu .mbar -tearoff 0
3755 .mbar add cascade -label Repository -menu .mbar.repository
3756 .mbar add cascade -label Edit -menu .mbar.edit
3757 if {!$single_commit} {
3758         .mbar add cascade -label Branch -menu .mbar.branch
3759 }
3760 .mbar add cascade -label Commit -menu .mbar.commit
3761 if {!$single_commit} {
3762         .mbar add cascade -label Fetch -menu .mbar.fetch
3763         .mbar add cascade -label Pull -menu .mbar.pull
3764         .mbar add cascade -label Push -menu .mbar.push
3765 }
3766 . configure -menu .mbar
3767
3768 # -- Repository Menu
3769 #
3770 menu .mbar.repository
3771 .mbar.repository add command \
3772         -label {Visualize Current Branch} \
3773         -command {do_gitk {}} \
3774         -font font_ui
3775 .mbar.repository add command \
3776         -label {Visualize All Branches} \
3777         -command {do_gitk {--all}} \
3778         -font font_ui
3779 .mbar.repository add separator
3780
3781 if {!$single_commit} {
3782         .mbar.repository add command -label {Database Statistics} \
3783                 -command do_stats \
3784                 -font font_ui
3785
3786         .mbar.repository add command -label {Compress Database} \
3787                 -command do_gc \
3788                 -font font_ui
3789
3790         .mbar.repository add command -label {Verify Database} \
3791                 -command do_fsck_objects \
3792                 -font font_ui
3793
3794         .mbar.repository add separator
3795
3796         if {[is_Windows]} {
3797                 .mbar.repository add command \
3798                         -label {Create Desktop Icon} \
3799                         -command do_windows_shortcut \
3800                         -font font_ui
3801         } elseif {[is_MacOSX]} {
3802                 .mbar.repository add command \
3803                         -label {Create Desktop Icon} \
3804                         -command do_macosx_app \
3805                         -font font_ui
3806         }
3807 }
3808
3809 .mbar.repository add command -label Quit \
3810         -command do_quit \
3811         -accelerator $M1T-Q \
3812         -font font_ui
3813
3814 # -- Edit Menu
3815 #
3816 menu .mbar.edit
3817 .mbar.edit add command -label Undo \
3818         -command {catch {[focus] edit undo}} \
3819         -accelerator $M1T-Z \
3820         -font font_ui
3821 .mbar.edit add command -label Redo \
3822         -command {catch {[focus] edit redo}} \
3823         -accelerator $M1T-Y \
3824         -font font_ui
3825 .mbar.edit add separator
3826 .mbar.edit add command -label Cut \
3827         -command {catch {tk_textCut [focus]}} \
3828         -accelerator $M1T-X \
3829         -font font_ui
3830 .mbar.edit add command -label Copy \
3831         -command {catch {tk_textCopy [focus]}} \
3832         -accelerator $M1T-C \
3833         -font font_ui
3834 .mbar.edit add command -label Paste \
3835         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3836         -accelerator $M1T-V \
3837         -font font_ui
3838 .mbar.edit add command -label Delete \
3839         -command {catch {[focus] delete sel.first sel.last}} \
3840         -accelerator Del \
3841         -font font_ui
3842 .mbar.edit add separator
3843 .mbar.edit add command -label {Select All} \
3844         -command {catch {[focus] tag add sel 0.0 end}} \
3845         -accelerator $M1T-A \
3846         -font font_ui
3847
3848 # -- Branch Menu
3849 #
3850 if {!$single_commit} {
3851         menu .mbar.branch
3852
3853         .mbar.branch add command -label {Create...} \
3854                 -command do_create_branch \
3855                 -accelerator $M1T-N \
3856                 -font font_ui
3857         lappend disable_on_lock [list .mbar.branch entryconf \
3858                 [.mbar.branch index last] -state]
3859
3860         .mbar.branch add command -label {Delete...} \
3861                 -command do_delete_branch \
3862                 -font font_ui
3863         lappend disable_on_lock [list .mbar.branch entryconf \
3864                 [.mbar.branch index last] -state]
3865 }
3866
3867 # -- Commit Menu
3868 #
3869 menu .mbar.commit
3870
3871 .mbar.commit add radiobutton \
3872         -label {New Commit} \
3873         -command do_select_commit_type \
3874         -variable selected_commit_type \
3875         -value new \
3876         -font font_ui
3877 lappend disable_on_lock \
3878         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3879
3880 .mbar.commit add radiobutton \
3881         -label {Amend Last Commit} \
3882         -command do_select_commit_type \
3883         -variable selected_commit_type \
3884         -value amend \
3885         -font font_ui
3886 lappend disable_on_lock \
3887         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3888
3889 .mbar.commit add separator
3890
3891 .mbar.commit add command -label Rescan \
3892         -command do_rescan \
3893         -accelerator F5 \
3894         -font font_ui
3895 lappend disable_on_lock \
3896         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3897
3898 .mbar.commit add command -label {Add To Commit} \
3899         -command do_add_selection \
3900         -font font_ui
3901 lappend disable_on_lock \
3902         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3903
3904 .mbar.commit add command -label {Add All To Commit} \
3905         -command do_add_all \
3906         -accelerator $M1T-I \
3907         -font font_ui
3908 lappend disable_on_lock \
3909         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3910
3911 .mbar.commit add command -label {Unstage From Commit} \
3912         -command do_unstage_selection \
3913         -font font_ui
3914 lappend disable_on_lock \
3915         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3916
3917 .mbar.commit add command -label {Revert Changes} \
3918         -command do_revert_selection \
3919         -font font_ui
3920 lappend disable_on_lock \
3921         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3922
3923 .mbar.commit add separator
3924
3925 .mbar.commit add command -label {Sign Off} \
3926         -command do_signoff \
3927         -accelerator $M1T-S \
3928         -font font_ui
3929
3930 .mbar.commit add command -label Commit \
3931         -command do_commit \
3932         -accelerator $M1T-Return \
3933         -font font_ui
3934 lappend disable_on_lock \
3935         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3936
3937 # -- Transport menus
3938 #
3939 if {!$single_commit} {
3940         menu .mbar.fetch
3941         menu .mbar.pull
3942         menu .mbar.push
3943 }
3944
3945 if {[is_MacOSX]} {
3946         # -- Apple Menu (Mac OS X only)
3947         #
3948         .mbar add cascade -label Apple -menu .mbar.apple
3949         menu .mbar.apple
3950
3951         .mbar.apple add command -label "About [appname]" \
3952                 -command do_about \
3953                 -font font_ui
3954         .mbar.apple add command -label "[appname] Options..." \
3955                 -command do_options \
3956                 -font font_ui
3957 } else {
3958         # -- Edit Menu
3959         #
3960         .mbar.edit add separator
3961         .mbar.edit add command -label {Options...} \
3962                 -command do_options \
3963                 -font font_ui
3964
3965         # -- Tools Menu
3966         #
3967         if {[file exists /usr/local/miga/lib/gui-miga]
3968                 && [file exists .pvcsrc]} {
3969         proc do_miga {} {
3970                 global ui_status_value
3971                 if {![lock_index update]} return
3972                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3973                 set miga_fd [open "|$cmd" r]
3974                 fconfigure $miga_fd -blocking 0
3975                 fileevent $miga_fd readable [list miga_done $miga_fd]
3976                 set ui_status_value {Running miga...}
3977         }
3978         proc miga_done {fd} {
3979                 read $fd 512
3980                 if {[eof $fd]} {
3981                         close $fd
3982                         unlock_index
3983                         rescan [list set ui_status_value {Ready.}]
3984                 }
3985         }
3986         .mbar add cascade -label Tools -menu .mbar.tools
3987         menu .mbar.tools
3988         .mbar.tools add command -label "Migrate" \
3989                 -command do_miga \
3990                 -font font_ui
3991         lappend disable_on_lock \
3992                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3993         }
3994
3995         # -- Help Menu
3996         #
3997         .mbar add cascade -label Help -menu .mbar.help
3998         menu .mbar.help
3999
4000         .mbar.help add command -label "About [appname]" \
4001                 -command do_about \
4002                 -font font_ui
4003 }
4004
4005
4006 # -- Branch Control
4007 #
4008 frame .branch \
4009         -borderwidth 1 \
4010         -relief sunken
4011 label .branch.l1 \
4012         -text {Current Branch:} \
4013         -anchor w \
4014         -justify left \
4015         -font font_ui
4016 label .branch.cb \
4017         -textvariable current_branch \
4018         -anchor w \
4019         -justify left \
4020         -font font_ui
4021 pack .branch.l1 -side left
4022 pack .branch.cb -side left -fill x
4023 pack .branch -side top -fill x
4024
4025 # -- Main Window Layout
4026 #
4027 panedwindow .vpane -orient vertical
4028 panedwindow .vpane.files -orient horizontal
4029 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4030 pack .vpane -anchor n -side top -fill both -expand 1
4031
4032 # -- Index File List
4033 #
4034 frame .vpane.files.index -height 100 -width 200
4035 label .vpane.files.index.title -text {Changes To Be Committed} \
4036         -background green \
4037         -font font_ui
4038 text $ui_index -background white -borderwidth 0 \
4039         -width 20 -height 10 \
4040         -wrap none \
4041         -font font_ui \
4042         -cursor $cursor_ptr \
4043         -xscrollcommand {.vpane.files.index.sx set} \
4044         -yscrollcommand {.vpane.files.index.sy set} \
4045         -state disabled
4046 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4047 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4048 pack .vpane.files.index.title -side top -fill x
4049 pack .vpane.files.index.sx -side bottom -fill x
4050 pack .vpane.files.index.sy -side right -fill y
4051 pack $ui_index -side left -fill both -expand 1
4052 .vpane.files add .vpane.files.index -sticky nsew
4053
4054 # -- Working Directory File List
4055 #
4056 frame .vpane.files.workdir -height 100 -width 200
4057 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4058         -background red \
4059         -font font_ui
4060 text $ui_workdir -background white -borderwidth 0 \
4061         -width 20 -height 10 \
4062         -wrap none \
4063         -font font_ui \
4064         -cursor $cursor_ptr \
4065         -xscrollcommand {.vpane.files.workdir.sx set} \
4066         -yscrollcommand {.vpane.files.workdir.sy set} \
4067         -state disabled
4068 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4069 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4070 pack .vpane.files.workdir.title -side top -fill x
4071 pack .vpane.files.workdir.sx -side bottom -fill x
4072 pack .vpane.files.workdir.sy -side right -fill y
4073 pack $ui_workdir -side left -fill both -expand 1
4074 .vpane.files add .vpane.files.workdir -sticky nsew
4075
4076 foreach i [list $ui_index $ui_workdir] {
4077         $i tag conf in_diff -font font_uibold
4078         $i tag conf in_sel \
4079                 -background [$i cget -foreground] \
4080                 -foreground [$i cget -background]
4081 }
4082 unset i
4083
4084 # -- Diff and Commit Area
4085 #
4086 frame .vpane.lower -height 300 -width 400
4087 frame .vpane.lower.commarea
4088 frame .vpane.lower.diff -relief sunken -borderwidth 1
4089 pack .vpane.lower.commarea -side top -fill x
4090 pack .vpane.lower.diff -side bottom -fill both -expand 1
4091 .vpane add .vpane.lower -sticky nsew
4092
4093 # -- Commit Area Buttons
4094 #
4095 frame .vpane.lower.commarea.buttons
4096 label .vpane.lower.commarea.buttons.l -text {} \
4097         -anchor w \
4098         -justify left \
4099         -font font_ui
4100 pack .vpane.lower.commarea.buttons.l -side top -fill x
4101 pack .vpane.lower.commarea.buttons -side left -fill y
4102
4103 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4104         -command do_rescan \
4105         -font font_ui
4106 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4107 lappend disable_on_lock \
4108         {.vpane.lower.commarea.buttons.rescan conf -state}
4109
4110 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4111         -command do_add_all \
4112         -font font_ui
4113 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4114 lappend disable_on_lock \
4115         {.vpane.lower.commarea.buttons.incall conf -state}
4116
4117 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4118         -command do_signoff \
4119         -font font_ui
4120 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4121
4122 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4123         -command do_commit \
4124         -font font_ui
4125 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4126 lappend disable_on_lock \
4127         {.vpane.lower.commarea.buttons.commit conf -state}
4128
4129 # -- Commit Message Buffer
4130 #
4131 frame .vpane.lower.commarea.buffer
4132 frame .vpane.lower.commarea.buffer.header
4133 set ui_comm .vpane.lower.commarea.buffer.t
4134 set ui_coml .vpane.lower.commarea.buffer.header.l
4135 radiobutton .vpane.lower.commarea.buffer.header.new \
4136         -text {New Commit} \
4137         -command do_select_commit_type \
4138         -variable selected_commit_type \
4139         -value new \
4140         -font font_ui
4141 lappend disable_on_lock \
4142         [list .vpane.lower.commarea.buffer.header.new conf -state]
4143 radiobutton .vpane.lower.commarea.buffer.header.amend \
4144         -text {Amend Last Commit} \
4145         -command do_select_commit_type \
4146         -variable selected_commit_type \
4147         -value amend \
4148         -font font_ui
4149 lappend disable_on_lock \
4150         [list .vpane.lower.commarea.buffer.header.amend conf -state]
4151 label $ui_coml \
4152         -anchor w \
4153         -justify left \
4154         -font font_ui
4155 proc trace_commit_type {varname args} {
4156         global ui_coml commit_type
4157         switch -glob -- $commit_type {
4158         initial       {set txt {Initial Commit Message:}}
4159         amend         {set txt {Amended Commit Message:}}
4160         amend-initial {set txt {Amended Initial Commit Message:}}
4161         amend-merge   {set txt {Amended Merge Commit Message:}}
4162         merge         {set txt {Merge Commit Message:}}
4163         *             {set txt {Commit Message:}}
4164         }
4165         $ui_coml conf -text $txt
4166 }
4167 trace add variable commit_type write trace_commit_type
4168 pack $ui_coml -side left -fill x
4169 pack .vpane.lower.commarea.buffer.header.amend -side right
4170 pack .vpane.lower.commarea.buffer.header.new -side right
4171
4172 text $ui_comm -background white -borderwidth 1 \
4173         -undo true \
4174         -maxundo 20 \
4175         -autoseparators true \
4176         -relief sunken \
4177         -width 75 -height 9 -wrap none \
4178         -font font_diff \
4179         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4180 scrollbar .vpane.lower.commarea.buffer.sby \
4181         -command [list $ui_comm yview]
4182 pack .vpane.lower.commarea.buffer.header -side top -fill x
4183 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4184 pack $ui_comm -side left -fill y
4185 pack .vpane.lower.commarea.buffer -side left -fill y
4186
4187 # -- Commit Message Buffer Context Menu
4188 #
4189 set ctxm .vpane.lower.commarea.buffer.ctxm
4190 menu $ctxm -tearoff 0
4191 $ctxm add command \
4192         -label {Cut} \
4193         -font font_ui \
4194         -command {tk_textCut $ui_comm}
4195 $ctxm add command \
4196         -label {Copy} \
4197         -font font_ui \
4198         -command {tk_textCopy $ui_comm}
4199 $ctxm add command \
4200         -label {Paste} \
4201         -font font_ui \
4202         -command {tk_textPaste $ui_comm}
4203 $ctxm add command \
4204         -label {Delete} \
4205         -font font_ui \
4206         -command {$ui_comm delete sel.first sel.last}
4207 $ctxm add separator
4208 $ctxm add command \
4209         -label {Select All} \
4210         -font font_ui \
4211         -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4212 $ctxm add command \
4213         -label {Copy All} \
4214         -font font_ui \
4215         -command {
4216                 $ui_comm tag add sel 0.0 end
4217                 tk_textCopy $ui_comm
4218                 $ui_comm tag remove sel 0.0 end
4219         }
4220 $ctxm add separator
4221 $ctxm add command \
4222         -label {Sign Off} \
4223         -font font_ui \
4224         -command do_signoff
4225 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
4226
4227 # -- Diff Header
4228 #
4229 set current_diff_path {}
4230 set current_diff_side {}
4231 set diff_actions [list]
4232 proc trace_current_diff_path {varname args} {
4233         global current_diff_path diff_actions file_states
4234         if {$current_diff_path eq {}} {
4235                 set s {}
4236                 set f {}
4237                 set p {}
4238                 set o disabled
4239         } else {
4240                 set p $current_diff_path
4241                 set s [mapdesc [lindex $file_states($p) 0] $p]
4242                 set f {File:}
4243                 set p [escape_path $p]
4244                 set o normal
4245         }
4246
4247         .vpane.lower.diff.header.status configure -text $s
4248         .vpane.lower.diff.header.file configure -text $f
4249         .vpane.lower.diff.header.path configure -text $p
4250         foreach w $diff_actions {
4251                 uplevel #0 $w $o
4252         }
4253 }
4254 trace add variable current_diff_path write trace_current_diff_path
4255
4256 frame .vpane.lower.diff.header -background orange
4257 label .vpane.lower.diff.header.status \
4258         -background orange \
4259         -width $max_status_desc \
4260         -anchor w \
4261         -justify left \
4262         -font font_ui
4263 label .vpane.lower.diff.header.file \
4264         -background orange \
4265         -anchor w \
4266         -justify left \
4267         -font font_ui
4268 label .vpane.lower.diff.header.path \
4269         -background orange \
4270         -anchor w \
4271         -justify left \
4272         -font font_ui
4273 pack .vpane.lower.diff.header.status -side left
4274 pack .vpane.lower.diff.header.file -side left
4275 pack .vpane.lower.diff.header.path -fill x
4276 set ctxm .vpane.lower.diff.header.ctxm
4277 menu $ctxm -tearoff 0
4278 $ctxm add command \
4279         -label {Copy} \
4280         -font font_ui \
4281         -command {
4282                 clipboard clear
4283                 clipboard append \
4284                         -format STRING \
4285                         -type STRING \
4286                         -- $current_diff_path
4287         }
4288 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4289 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
4290
4291 # -- Diff Body
4292 #
4293 frame .vpane.lower.diff.body
4294 set ui_diff .vpane.lower.diff.body.t
4295 text $ui_diff -background white -borderwidth 0 \
4296         -width 80 -height 15 -wrap none \
4297         -font font_diff \
4298         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4299         -yscrollcommand {.vpane.lower.diff.body.sby set} \
4300         -state disabled
4301 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4302         -command [list $ui_diff xview]
4303 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4304         -command [list $ui_diff yview]
4305 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4306 pack .vpane.lower.diff.body.sby -side right -fill y
4307 pack $ui_diff -side left -fill both -expand 1
4308 pack .vpane.lower.diff.header -side top -fill x
4309 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4310
4311 $ui_diff tag conf d_cr -elide true
4312 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4313 $ui_diff tag conf d_+ -foreground {#00a000}
4314 $ui_diff tag conf d_- -foreground red
4315
4316 $ui_diff tag conf d_++ -foreground {#00a000}
4317 $ui_diff tag conf d_-- -foreground red
4318 $ui_diff tag conf d_+s \
4319         -foreground {#00a000} \
4320         -background {#e2effa}
4321 $ui_diff tag conf d_-s \
4322         -foreground red \
4323         -background {#e2effa}
4324 $ui_diff tag conf d_s+ \
4325         -foreground {#00a000} \
4326         -background ivory1
4327 $ui_diff tag conf d_s- \
4328         -foreground red \
4329         -background ivory1
4330
4331 $ui_diff tag conf d<<<<<<< \
4332         -foreground orange \
4333         -font font_diffbold
4334 $ui_diff tag conf d======= \
4335         -foreground orange \
4336         -font font_diffbold
4337 $ui_diff tag conf d>>>>>>> \
4338         -foreground orange \
4339         -font font_diffbold
4340
4341 $ui_diff tag raise sel
4342
4343 # -- Diff Body Context Menu
4344 #
4345 set ctxm .vpane.lower.diff.body.ctxm
4346 menu $ctxm -tearoff 0
4347 $ctxm add command \
4348         -label {Refresh} \
4349         -font font_ui \
4350         -command reshow_diff
4351 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4352 $ctxm add command \
4353         -label {Copy} \
4354         -font font_ui \
4355         -command {tk_textCopy $ui_diff}
4356 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4357 $ctxm add command \
4358         -label {Select All} \
4359         -font font_ui \
4360         -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4361 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4362 $ctxm add command \
4363         -label {Copy All} \
4364         -font font_ui \
4365         -command {
4366                 $ui_diff tag add sel 0.0 end
4367                 tk_textCopy $ui_diff
4368                 $ui_diff tag remove sel 0.0 end
4369         }
4370 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4371 $ctxm add separator
4372 $ctxm add command \
4373         -label {Apply/Reverse Hunk} \
4374         -font font_ui \
4375         -command {apply_hunk $cursorX $cursorY}
4376 set ui_diff_applyhunk [$ctxm index last]
4377 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4378 $ctxm add separator
4379 $ctxm add command \
4380         -label {Decrease Font Size} \
4381         -font font_ui \
4382         -command {incr_font_size font_diff -1}
4383 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4384 $ctxm add command \
4385         -label {Increase Font Size} \
4386         -font font_ui \
4387         -command {incr_font_size font_diff 1}
4388 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4389 $ctxm add separator
4390 $ctxm add command \
4391         -label {Show Less Context} \
4392         -font font_ui \
4393         -command {if {$repo_config(gui.diffcontext) >= 2} {
4394                 incr repo_config(gui.diffcontext) -1
4395                 reshow_diff
4396         }}
4397 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4398 $ctxm add command \
4399         -label {Show More Context} \
4400         -font font_ui \
4401         -command {
4402                 incr repo_config(gui.diffcontext)
4403                 reshow_diff
4404         }
4405 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4406 $ctxm add separator
4407 $ctxm add command -label {Options...} \
4408         -font font_ui \
4409         -command do_options
4410 bind_button3 $ui_diff "
4411         set cursorX %x
4412         set cursorY %y
4413         if {\$ui_index eq \$current_diff_side} {
4414                 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
4415         } else {
4416                 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
4417         }
4418         tk_popup $ctxm %X %Y
4419 "
4420 unset ui_diff_applyhunk
4421
4422 # -- Status Bar
4423 #
4424 set ui_status_value {Initializing...}
4425 label .status -textvariable ui_status_value \
4426         -anchor w \
4427         -justify left \
4428         -borderwidth 1 \
4429         -relief sunken \
4430         -font font_ui
4431 pack .status -anchor w -side bottom -fill x
4432
4433 # -- Load geometry
4434 #
4435 catch {
4436 set gm $repo_config(gui.geometry)
4437 wm geometry . [lindex $gm 0]
4438 .vpane sash place 0 \
4439         [lindex [.vpane sash coord 0] 0] \
4440         [lindex $gm 1]
4441 .vpane.files sash place 0 \
4442         [lindex $gm 2] \
4443         [lindex [.vpane.files sash coord 0] 1]
4444 unset gm
4445 }
4446
4447 # -- Key Bindings
4448 #
4449 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4450 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4451 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4452 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4453 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4454 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4455 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4456 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4457 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4458 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4459 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4460
4461 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4462 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4463 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4464 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4465 bind $ui_diff <$M1B-Key-v> {break}
4466 bind $ui_diff <$M1B-Key-V> {break}
4467 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4468 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4469 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
4470 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
4471 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
4472 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
4473 bind $ui_diff <Button-1>   {focus %W}
4474
4475 if {!$single_commit} {
4476         bind . <$M1B-Key-n> do_create_branch
4477         bind . <$M1B-Key-N> do_create_branch
4478 }
4479
4480 bind .   <Destroy> do_quit
4481 bind all <Key-F5> do_rescan
4482 bind all <$M1B-Key-r> do_rescan
4483 bind all <$M1B-Key-R> do_rescan
4484 bind .   <$M1B-Key-s> do_signoff
4485 bind .   <$M1B-Key-S> do_signoff
4486 bind .   <$M1B-Key-i> do_add_all
4487 bind .   <$M1B-Key-I> do_add_all
4488 bind .   <$M1B-Key-Return> do_commit
4489 bind all <$M1B-Key-q> do_quit
4490 bind all <$M1B-Key-Q> do_quit
4491 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4492 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4493 foreach i [list $ui_index $ui_workdir] {
4494         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
4495         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
4496         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
4497 }
4498 unset i
4499
4500 set file_lists($ui_index) [list]
4501 set file_lists($ui_workdir) [list]
4502
4503 set HEAD {}
4504 set PARENT {}
4505 set MERGE_HEAD [list]
4506 set commit_type {}
4507 set empty_tree {}
4508 set current_branch {}
4509 set current_diff_path {}
4510 set selected_commit_type new
4511
4512 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
4513 focus -force $ui_comm
4514
4515 # -- Warn the user about environmental problems.  Cygwin's Tcl
4516 #    does *not* pass its env array onto any processes it spawns.
4517 #    This means that git processes get none of our environment.
4518 #
4519 if {[is_Windows]} {
4520         set ignored_env 0
4521         set suggest_user {}
4522         set msg "Possible environment issues exist.
4523
4524 The following environment variables are probably
4525 going to be ignored by any Git subprocess run
4526 by [appname]:
4527
4528 "
4529         foreach name [array names env] {
4530                 switch -regexp -- $name {
4531                 {^GIT_INDEX_FILE$} -
4532                 {^GIT_OBJECT_DIRECTORY$} -
4533                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4534                 {^GIT_DIFF_OPTS$} -
4535                 {^GIT_EXTERNAL_DIFF$} -
4536                 {^GIT_PAGER$} -
4537                 {^GIT_TRACE$} -
4538                 {^GIT_CONFIG$} -
4539                 {^GIT_CONFIG_LOCAL$} -
4540                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4541                         append msg " - $name\n"
4542                         incr ignored_env
4543                 }
4544                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4545                         append msg " - $name\n"
4546                         incr ignored_env
4547                         set suggest_user $name
4548                 }
4549                 }
4550         }
4551         if {$ignored_env > 0} {
4552                 append msg "
4553 This is due to a known issue with the
4554 Tcl binary distributed by Cygwin."
4555
4556                 if {$suggest_user ne {}} {
4557                         append msg "
4558
4559 A good replacement for $suggest_user
4560 is placing values for the user.name and
4561 user.email settings into your personal
4562 ~/.gitconfig file.
4563 "
4564                 }
4565                 warn_popup $msg
4566         }
4567         unset ignored_env msg suggest_user name
4568 }
4569
4570 # -- Only initialize complex UI if we are going to stay running.
4571 #
4572 if {!$single_commit} {
4573         load_all_remotes
4574         load_all_heads
4575
4576         populate_branch_menu
4577         populate_fetch_menu .mbar.fetch
4578         populate_pull_menu .mbar.pull
4579         populate_push_menu .mbar.push
4580 }
4581
4582 # -- Only suggest a gc run if we are going to stay running.
4583 #
4584 if {!$single_commit} {
4585         set object_limit 2000
4586         if {[is_Windows]} {set object_limit 200}
4587         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4588         if {$objects_current >= $object_limit} {
4589                 if {[ask_popup \
4590                         "This repository currently has $objects_current loose objects.
4591
4592 To maintain optimal performance it is strongly
4593 recommended that you compress the database
4594 when more than $object_limit loose objects exist.
4595
4596 Compress the database now?"] eq yes} {
4597                         do_gc
4598                 }
4599         }
4600         unset object_limit _junk objects_current
4601 }
4602
4603 lock_index begin-read
4604 after 1 do_rescan