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} {
 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 {$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
 414         fconfigure $fd_df -blocking 0 -translation binary
 415         fconfigure $fd_lo -blocking 0 -translation 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                 $ui_comm delete 0.0 end
 432                 $ui_comm insert end $content
 433                 return 1
 434         }
 435         return 0
 436 }
 437
 438 proc read_diff_index {fd after} {
 439         global buf_rdi
 440
 441         append buf_rdi [read $fd]
 442         set c 0
 443         set n [string length $buf_rdi]
 444         while {$c < $n} {
 445                 set z1 [string first "\0" $buf_rdi $c]
 446                 if {$z1 == -1} break
 447                 incr z1
 448                 set z2 [string first "\0" $buf_rdi $z1]
 449                 if {$z2 == -1} break
 450
 451                 incr c
 452                 set i [split [string range $buf_rdi $c [expr {$z1 - 2}]] { }]
 453                 merge_state \
 454                         [string range $buf_rdi $z1 [expr {$z2 - 1}]] \
 455                         [lindex $i 4]? \
 456                         [list [lindex $i 0] [lindex $i 2]] \
 457                         [list]
 458                 set c $z2
 459                 incr c
 460         }
 461         if {$c < $n} {
 462                 set buf_rdi [string range $buf_rdi $c end]
 463         } else {
 464                 set buf_rdi {}
 465         }
 466
 467         rescan_done $fd buf_rdi $after
 468 }
 469
 470 proc read_diff_files {fd after} {
 471         global buf_rdf
 472
 473         append buf_rdf [read $fd]
 474         set c 0
 475         set n [string length $buf_rdf]
 476         while {$c < $n} {
 477                 set z1 [string first "\0" $buf_rdf $c]
 478                 if {$z1 == -1} break
 479                 incr z1
 480                 set z2 [string first "\0" $buf_rdf $z1]
 481                 if {$z2 == -1} break
 482
 483                 incr c
 484                 set i [split [string range $buf_rdf $c [expr {$z1 - 2}]] { }]
 485                 merge_state \
 486                         [string range $buf_rdf $z1 [expr {$z2 - 1}]] \
 487                         ?[lindex $i 4] \
 488                         [list] \
 489                         [list [lindex $i 0] [lindex $i 2]]
 490                 set c $z2
 491                 incr c
 492         }
 493         if {$c < $n} {
 494                 set buf_rdf [string range $buf_rdf $c end]
 495         } else {
 496                 set buf_rdf {}
 497         }
 498
 499         rescan_done $fd buf_rdf $after
 500 }
 501
 502 proc read_ls_others {fd after} {
 503         global buf_rlo
 504
 505         append buf_rlo [read $fd]
 506         set pck [split $buf_rlo "\0"]
 507         set buf_rlo [lindex $pck end]
 508         foreach p [lrange $pck 0 end-1] {
 509                 merge_state $p ?O
 510         }
 511         rescan_done $fd buf_rlo $after
 512 }
 513
 514 proc rescan_done {fd buf after} {
 515         global rescan_active
 516         global file_states repo_config
 517         upvar $buf to_clear
 518
 519         if {![eof $fd]} return
 520         set to_clear {}
 521         close $fd
 522         if {[incr rescan_active -1] > 0} return
 523
 524         prune_selection
 525         unlock_index
 526         display_all_files
 527
 528         if {$repo_config(gui.partialinclude) ne {true}} {
 529                 set pathList [list]
 530                 foreach path [array names file_states] {
 531                         switch -- [lindex $file_states($path) 0] {
 532                         A? -
 533                         M? {lappend pathList $path}
 534                         }
 535                 }
 536                 if {$pathList ne {}} {
 537                         update_index \
 538                                 "Updating included files" \
 539                                 $pathList \
 540                                 [concat {reshow_diff;} $after]
 541                         return
 542                 }
 543         }
 544
 545         reshow_diff
 546         uplevel #0 $after
 547 }
 548
 549 proc prune_selection {} {
 550         global file_states selected_paths
 551
 552         foreach path [array names selected_paths] {
 553                 if {[catch {set still_here $file_states($path)}]} {
 554                         unset selected_paths($path)
 555                 }
 556         }
 557 }
 558
 559 ######################################################################
 560 ##
 561 ## diff
 562
 563 proc clear_diff {} {
 564         global ui_diff current_diff ui_index ui_workdir
 565
 566         $ui_diff conf -state normal
 567         $ui_diff delete 0.0 end
 568         $ui_diff conf -state disabled
 569
 570         set current_diff {}
 571
 572         $ui_index tag remove in_diff 0.0 end
 573         $ui_workdir tag remove in_diff 0.0 end
 574 }
 575
 576 proc reshow_diff {} {
 577         global current_diff ui_status_value file_states
 578
 579         if {$current_diff eq {}
 580                 || [catch {set s $file_states($current_diff)}]} {
 581                 clear_diff
 582         } else {
 583                 show_diff $current_diff
 584         }
 585 }
 586
 587 proc handle_empty_diff {} {
 588         global current_diff file_states file_lists
 589
 590         set path $current_diff
 591         set s $file_states($path)
 592         if {[lindex $s 0] ne {_M}} return
 593
 594         info_popup "No differences detected.
 595
 596 [short_path $path] has no changes.
 597
 598 The modification date of this file was updated
 599 by another application and you currently have
 600 the Trust File Modification Timestamps option
 601 enabled, so Git did not automatically detect
 602 that there are no content differences in this
 603 file.
 604
 605 This file will now be removed from the modified
 606 files list, to prevent possible confusion.
 607 "
 608         if {[catch {exec git update-index -- $path} err]} {
 609                 error_popup "Failed to refresh index:\n\n$err"
 610         }
 611
 612         clear_diff
 613         set old_w [mapcol [lindex $file_states($path) 0] $path]
 614         set lno [lsearch -sorted $file_lists($old_w) $path]
 615         if {$lno >= 0} {
 616                 set file_lists($old_w) \
 617                         [lreplace $file_lists($old_w) $lno $lno]
 618                 incr lno
 619                 $old_w conf -state normal
 620                 $old_w delete $lno.0 [expr {$lno + 1}].0
 621                 $old_w conf -state disabled
 622         }
 623 }
 624
 625 proc show_diff {path {w {}} {lno {}}} {
 626         global file_states file_lists
 627         global is_3way_diff diff_active repo_config
 628         global ui_diff current_diff ui_status_value
 629
 630         if {$diff_active || ![lock_index read]} return
 631
 632         clear_diff
 633         if {$w eq {} || $lno == {}} {
 634                 foreach w [array names file_lists] {
 635                         set lno [lsearch -sorted $file_lists($w) $path]
 636                         if {$lno >= 0} {
 637                                 incr lno
 638                                 break
 639                         }
 640                 }
 641         }
 642         if {$w ne {} && $lno >= 1} {
 643                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 644         }
 645
 646         set s $file_states($path)
 647         set m [lindex $s 0]
 648         set is_3way_diff 0
 649         set diff_active 1
 650         set current_diff $path
 651         set ui_status_value "Loading diff of [escape_path $path]..."
 652
 653         set cmd [list | git diff-index]
 654         lappend cmd --no-color
 655         if {$repo_config(gui.diffcontext) > 0} {
 656                 lappend cmd "-U$repo_config(gui.diffcontext)"
 657         }
 658         lappend cmd -p
 659
 660         switch $m {
 661         MM {
 662                 lappend cmd -c
 663         }
 664         _O {
 665                 if {[catch {
 666                                 set fd [open $path r]
 667                                 set content [read $fd]
 668                                 close $fd
 669                         } err ]} {
 670                         set diff_active 0
 671                         unlock_index
 672                         set ui_status_value "Unable to display [escape_path $path]"
 673                         error_popup "Error loading file:\n\n$err"
 674                         return
 675                 }
 676                 $ui_diff conf -state normal
 677                 $ui_diff insert end $content
 678                 $ui_diff conf -state disabled
 679                 set diff_active 0
 680                 unlock_index
 681                 set ui_status_value {Ready.}
 682                 return
 683         }
 684         }
 685
 686         lappend cmd [PARENT]
 687         lappend cmd --
 688         lappend cmd $path
 689
 690         if {[catch {set fd [open $cmd r]} err]} {
 691                 set diff_active 0
 692                 unlock_index
 693                 set ui_status_value "Unable to display [escape_path $path]"
 694                 error_popup "Error loading diff:\n\n$err"
 695                 return
 696         }
 697
 698         fconfigure $fd -blocking 0 -translation auto
 699         fileevent $fd readable [list read_diff $fd]
 700 }
 701
 702 proc read_diff {fd} {
 703         global ui_diff ui_status_value is_3way_diff diff_active
 704         global repo_config
 705
 706         $ui_diff conf -state normal
 707         while {[gets $fd line] >= 0} {
 708                 # -- Cleanup uninteresting diff header lines.
 709                 #
 710                 if {[string match {diff --git *}      $line]} continue
 711                 if {[string match {diff --combined *} $line]} continue
 712                 if {[string match {--- *}             $line]} continue
 713                 if {[string match {+++ *}             $line]} continue
 714                 if {$line eq {deleted file mode 120000}} {
 715                         set line "deleted symlink"
 716                 }
 717
 718                 # -- Automatically detect if this is a 3 way diff.
 719                 #
 720                 if {[string match {@@@ *} $line]} {set is_3way_diff 1}
 721
 722                 # -- Reformat a 3 way diff, 'cause its too weird.
 723                 #
 724                 if {$is_3way_diff} {
 725                         set op [string range $line 0 1]
 726                         switch -- $op {
 727                         {@@} {set tags d_@}
 728                         {++} {set tags d_+ ; set op { +}}
 729                         {--} {set tags d_- ; set op { -}}
 730                         { +} {set tags d_++; set op {++}}
 731                         { -} {set tags d_--; set op {--}}
 732                         {+ } {set tags d_-+; set op {-+}}
 733                         {- } {set tags d_+-; set op {+-}}
 734                         default {set tags {}}
 735                         }
 736                         set line [string replace $line 0 1 $op]
 737                 } else {
 738                         switch -- [string index $line 0] {
 739                         @ {set tags d_@}
 740                         + {set tags d_+}
 741                         - {set tags d_-}
 742                         default {set tags {}}
 743                         }
 744                 }
 745                 $ui_diff insert end $line $tags
 746                 $ui_diff insert end "\n" $tags
 747         }
 748         $ui_diff conf -state disabled
 749
 750         if {[eof $fd]} {
 751                 close $fd
 752                 set diff_active 0
 753                 unlock_index
 754                 set ui_status_value {Ready.}
 755
 756                 if {$repo_config(gui.trustmtime) eq {true}
 757                         && [$ui_diff index end] eq {2.0}} {
 758                         handle_empty_diff
 759                 }
 760         }
 761 }
 762
 763 ######################################################################
 764 ##
 765 ## commit
 766
 767 proc load_last_commit {} {
 768         global HEAD PARENT MERGE_HEAD commit_type ui_comm
 769
 770         if {[llength $PARENT] == 0} {
 771                 error_popup {There is nothing to amend.
 772
 773 You are about to create the initial commit.
 774 There is no commit before this to amend.
 775 }
 776                 return
 777         }
 778
 779         repository_state curType curHEAD curMERGE_HEAD
 780         if {$curType eq {merge}} {
 781                 error_popup {Cannot amend while merging.
 782
 783 You are currently in the middle of a merge that
 784 has not been fully completed.  You cannot amend
 785 the prior commit unless you first abort the
 786 current merge activity.
 787 }
 788                 return
 789         }
 790
 791         set msg {}
 792         set parents [list]
 793         if {[catch {
 794                         set fd [open "| git cat-file commit $curHEAD" r]
 795                         while {[gets $fd line] > 0} {
 796                                 if {[string match {parent *} $line]} {
 797                                         lappend parents [string range $line 7 end]
 798                                 }
 799                         }
 800                         set msg [string trim [read $fd]]
 801                         close $fd
 802                 } err]} {
 803                 error_popup "Error loading commit data for amend:\n\n$err"
 804                 return
 805         }
 806
 807         set HEAD $curHEAD
 808         set PARENT $parents
 809         set MERGE_HEAD [list]
 810         switch -- [llength $parents] {
 811         0       {set commit_type amend-initial}
 812         1       {set commit_type amend}
 813         default {set commit_type amend-merge}
 814         }
 815
 816         $ui_comm delete 0.0 end
 817         $ui_comm insert end $msg
 818         $ui_comm edit reset
 819         $ui_comm edit modified false
 820         rescan {set ui_status_value {Ready.}}
 821 }
 822
 823 proc create_new_commit {} {
 824         global commit_type ui_comm
 825
 826         set commit_type normal
 827         $ui_comm delete 0.0 end
 828         $ui_comm edit reset
 829         $ui_comm edit modified false
 830         rescan {set ui_status_value {Ready.}}
 831 }
 832
 833 set GIT_COMMITTER_IDENT {}
 834
 835 proc committer_ident {} {
 836         global GIT_COMMITTER_IDENT
 837
 838         if {$GIT_COMMITTER_IDENT eq {}} {
 839                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
 840                         error_popup "Unable to obtain your identity:\n\n$err"
 841                         return {}
 842                 }
 843                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
 844                         $me me GIT_COMMITTER_IDENT]} {
 845                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
 846                         return {}
 847                 }
 848         }
 849
 850         return $GIT_COMMITTER_IDENT
 851 }
 852
 853 proc commit_tree {} {
 854         global HEAD commit_type file_states ui_comm repo_config
 855
 856         if {![lock_index update]} return
 857         if {[committer_ident] eq {}} return
 858
 859         # -- Our in memory state should match the repository.
 860         #
 861         repository_state curType curHEAD curMERGE_HEAD
 862         if {[string match amend* $commit_type]
 863                 && $curType eq {normal}
 864                 && $curHEAD eq $HEAD} {
 865         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
 866                 info_popup {Last scanned state does not match repository state.
 867
 868 Another Git program has modified this repository
 869 since the last scan.  A rescan must be performed
 870 before another commit can be created.
 871
 872 The rescan will be automatically started now.
 873 }
 874                 unlock_index
 875                 rescan {set ui_status_value {Ready.}}
 876                 return
 877         }
 878
 879         # -- At least one file should differ in the index.
 880         #
 881         set files_ready 0
 882         foreach path [array names file_states] {
 883                 switch -glob -- [lindex $file_states($path) 0] {
 884                 _? {continue}
 885                 A? -
 886                 D? -
 887                 M? {set files_ready 1; break}
 888                 U? {
 889                         error_popup "Unmerged files cannot be committed.
 890
 891 File [short_path $path] has merge conflicts.
 892 You must resolve them and include the file before committing.
 893 "
 894                         unlock_index
 895                         return
 896                 }
 897                 default {
 898                         error_popup "Unknown file state [lindex $s 0] detected.
 899
 900 File [short_path $path] cannot be committed by this program.
 901 "
 902                 }
 903                 }
 904         }
 905         if {!$files_ready} {
 906                 error_popup {No included files to commit.
 907
 908 You must include at least 1 file before you can commit.
 909 }
 910                 unlock_index
 911                 return
 912         }
 913
 914         # -- A message is required.
 915         #
 916         set msg [string trim [$ui_comm get 1.0 end]]
 917         if {$msg eq {}} {
 918                 error_popup {Please supply a commit message.
 919
 920 A good commit message has the following format:
 921
 922 - First line: Describe in one sentance what you did.
 923 - Second line: Blank
 924 - Remaining lines: Describe why this change is good.
 925 }
 926                 unlock_index
 927                 return
 928         }
 929
 930         # -- Update included files if partialincludes are off.
 931         #
 932         if {$repo_config(gui.partialinclude) ne {true}} {
 933                 set pathList [list]
 934                 foreach path [array names file_states] {
 935                         switch -glob -- [lindex $file_states($path) 0] {
 936                         A? -
 937                         M? {lappend pathList $path}
 938                         }
 939                 }
 940                 if {$pathList ne {}} {
 941                         unlock_index
 942                         update_index \
 943                                 "Updating included files" \
 944                                 $pathList \
 945                                 [concat {lock_index update;} \
 946                                         [list commit_prehook $curHEAD $msg]]
 947                         return
 948                 }
 949         }
 950
 951         commit_prehook $curHEAD $msg
 952 }
 953
 954 proc commit_prehook {curHEAD msg} {
 955         global ui_status_value pch_error
 956
 957         set pchook [gitdir hooks pre-commit]
 958
 959         # On Cygwin [file executable] might lie so we need to ask
 960         # the shell if the hook is executable.  Yes that's annoying.
 961         #
 962         if {[is_Windows] && [file isfile $pchook]} {
 963                 set pchook [list sh -c [concat \
 964                         "if test -x \"$pchook\";" \
 965                         "then exec \"$pchook\" 2>&1;" \
 966                         "fi"]]
 967         } elseif {[file executable $pchook]} {
 968                 set pchook [list $pchook |& cat]
 969         } else {
 970                 commit_writetree $curHEAD $msg
 971                 return
 972         }
 973
 974         set ui_status_value {Calling pre-commit hook...}
 975         set pch_error {}
 976         set fd_ph [open "| $pchook" r]
 977         fconfigure $fd_ph -blocking 0 -translation binary
 978         fileevent $fd_ph readable \
 979                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
 980 }
 981
 982 proc commit_prehook_wait {fd_ph curHEAD msg} {
 983         global pch_error ui_status_value
 984
 985         append pch_error [read $fd_ph]
 986         fconfigure $fd_ph -blocking 1
 987         if {[eof $fd_ph]} {
 988                 if {[catch {close $fd_ph}]} {
 989                         set ui_status_value {Commit declined by pre-commit hook.}
 990                         hook_failed_popup pre-commit $pch_error
 991                         unlock_index
 992                 } else {
 993                         commit_writetree $curHEAD $msg
 994                 }
 995                 set pch_error {}
 996                 return
 997         }
 998         fconfigure $fd_ph -blocking 0
 999 }
1000
1001 proc commit_writetree {curHEAD msg} {
1002         global ui_status_value
1003
1004         set ui_status_value {Committing changes...}
1005         set fd_wt [open "| git write-tree" r]
1006         fileevent $fd_wt readable \
1007                 [list commit_committree $fd_wt $curHEAD $msg]
1008 }
1009
1010 proc commit_committree {fd_wt curHEAD msg} {
1011         global HEAD PARENT MERGE_HEAD commit_type
1012         global single_commit
1013         global ui_status_value ui_comm selected_commit_type
1014         global file_states selected_paths rescan_active
1015
1016         gets $fd_wt tree_id
1017         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
1018                 error_popup "write-tree failed:\n\n$err"
1019                 set ui_status_value {Commit failed.}
1020                 unlock_index
1021                 return
1022         }
1023
1024         # -- Create the commit.
1025         #
1026         set cmd [list git commit-tree $tree_id]
1027         set parents [concat $PARENT $MERGE_HEAD]
1028         if {[llength $parents] > 0} {
1029                 foreach p $parents {
1030                         lappend cmd -p $p
1031                 }
1032         } else {
1033                 # git commit-tree writes to stderr during initial commit.
1034                 lappend cmd 2>/dev/null
1035         }
1036         lappend cmd << $msg
1037         if {[catch {set cmt_id [eval exec $cmd]} err]} {
1038                 error_popup "commit-tree failed:\n\n$err"
1039                 set ui_status_value {Commit failed.}
1040                 unlock_index
1041                 return
1042         }
1043
1044         # -- Update the HEAD ref.
1045         #
1046         set reflogm commit
1047         if {$commit_type ne {normal}} {
1048                 append reflogm " ($commit_type)"
1049         }
1050         set i [string first "\n" $msg]
1051         if {$i >= 0} {
1052                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
1053         } else {
1054                 append reflogm {: } $msg
1055         }
1056         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
1057         if {[catch {eval exec $cmd} err]} {
1058                 error_popup "update-ref failed:\n\n$err"
1059                 set ui_status_value {Commit failed.}
1060                 unlock_index
1061                 return
1062         }
1063
1064         # -- Cleanup after ourselves.
1065         #
1066         catch {file delete [gitdir MERGE_HEAD]}
1067         catch {file delete [gitdir MERGE_MSG]}
1068         catch {file delete [gitdir SQUASH_MSG]}
1069         catch {file delete [gitdir GITGUI_MSG]}
1070
1071         # -- Let rerere do its thing.
1072         #
1073         if {[file isdirectory [gitdir rr-cache]]} {
1074                 catch {exec git rerere}
1075         }
1076
1077         # -- Run the post-commit hook.
1078         #
1079         set pchook [gitdir hooks post-commit]
1080         if {[is_Windows] && [file isfile $pchook]} {
1081                 set pchook [list sh -c [concat \
1082                         "if test -x \"$pchook\";" \
1083                         "then exec \"$pchook\";" \
1084                         "fi"]]
1085         } elseif {![file executable $pchook]} {
1086                 set pchook {}
1087         }
1088         if {$pchook ne {}} {
1089                 catch {exec $pchook &}
1090         }
1091
1092         $ui_comm delete 0.0 end
1093         $ui_comm edit reset
1094         $ui_comm edit modified false
1095
1096         if {$single_commit} do_quit
1097
1098         # -- Update in memory status
1099         #
1100         set selected_commit_type new
1101         set commit_type normal
1102         set HEAD $cmt_id
1103         set PARENT $cmt_id
1104         set MERGE_HEAD [list]
1105
1106         foreach path [array names file_states] {
1107                 set s $file_states($path)
1108                 set m [lindex $s 0]
1109                 switch -glob -- $m {
1110                 _O -
1111                 _M -
1112                 _D {continue}
1113                 __ -
1114                 A_ -
1115                 M_ -
1116                 DD {
1117                         unset file_states($path)
1118                         catch {unset selected_paths($path)}
1119                 }
1120                 DO {
1121                         set file_states($path) [list _O [lindex $s 1] {} {}]
1122                 }
1123                 AM -
1124                 AD -
1125                 MM -
1126                 MD -
1127                 DM {
1128                         set file_states($path) [list \
1129                                 _[string index $m 1] \
1130                                 [lindex $s 1] \
1131                                 [lindex $s 3] \
1132                                 {}]
1133                 }
1134                 }
1135         }
1136
1137         display_all_files
1138         unlock_index
1139         reshow_diff
1140         set ui_status_value \
1141                 "Changes committed as [string range $cmt_id 0 7]."
1142 }
1143
1144 ######################################################################
1145 ##
1146 ## fetch pull push
1147
1148 proc fetch_from {remote} {
1149         set w [new_console "fetch $remote" \
1150                 "Fetching new changes from $remote"]
1151         set cmd [list git fetch]
1152         lappend cmd $remote
1153         console_exec $w $cmd
1154 }
1155
1156 proc pull_remote {remote branch} {
1157         global HEAD commit_type file_states repo_config
1158
1159         if {![lock_index update]} return
1160
1161         # -- Our in memory state should match the repository.
1162         #
1163         repository_state curType curHEAD curMERGE_HEAD
1164         if {$commit_type ne $curType || $HEAD ne $curHEAD} {
1165                 info_popup {Last scanned state does not match repository state.
1166
1167 Another Git program has modified this repository
1168 since the last scan.  A rescan must be performed
1169 before a pull operation can be started.
1170
1171 The rescan will be automatically started now.
1172 }
1173                 unlock_index
1174                 rescan {set ui_status_value {Ready.}}
1175                 return
1176         }
1177
1178         # -- No differences should exist before a pull.
1179         #
1180         if {[array size file_states] != 0} {
1181                 error_popup {Uncommitted but modified files are present.
1182
1183 You should not perform a pull with unmodified
1184 files in your working directory as Git will be
1185 unable to recover from an incorrect merge.
1186
1187 You should commit or revert all changes before
1188 starting a pull operation.
1189 }
1190                 unlock_index
1191                 return
1192         }
1193
1194         set w [new_console "pull $remote $branch" \
1195                 "Pulling new changes from branch $branch in $remote"]
1196         set cmd [list git pull]
1197         if {$repo_config(gui.pullsummary) eq {false}} {
1198                 lappend cmd --no-summary
1199         }
1200         lappend cmd $remote
1201         lappend cmd $branch
1202         console_exec $w $cmd [list post_pull_remote $remote $branch]
1203 }
1204
1205 proc post_pull_remote {remote branch success} {
1206         global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1207         global ui_status_value
1208
1209         unlock_index
1210         if {$success} {
1211                 repository_state commit_type HEAD MERGE_HEAD
1212                 set PARENT $HEAD
1213                 set selected_commit_type new
1214                 set ui_status_value "Pulling $branch from $remote complete."
1215         } else {
1216                 rescan [list set ui_status_value \
1217                         "Conflicts detected while pulling $branch from $remote."]
1218         }
1219 }
1220
1221 proc push_to {remote} {
1222         set w [new_console "push $remote" \
1223                 "Pushing changes to $remote"]
1224         set cmd [list git push]
1225         lappend cmd $remote
1226         console_exec $w $cmd
1227 }
1228
1229 ######################################################################
1230 ##
1231 ## ui helpers
1232
1233 proc mapcol {state path} {
1234         global all_cols ui_workdir
1235
1236         if {[catch {set r $all_cols($state)}]} {
1237                 puts "error: no column for state={$state} $path"
1238                 return $ui_workdir
1239         }
1240         return $r
1241 }
1242
1243 proc mapicon {state path} {
1244         global all_icons
1245
1246         if {[catch {set r $all_icons($state)}]} {
1247                 puts "error: no icon for state={$state} $path"
1248                 return file_plain
1249         }
1250         return $r
1251 }
1252
1253 proc mapdesc {state path} {
1254         global all_descs
1255
1256         if {[catch {set r $all_descs($state)}]} {
1257                 puts "error: no desc for state={$state} $path"
1258                 return $state
1259         }
1260         return $r
1261 }
1262
1263 proc escape_path {path} {
1264         regsub -all "\n" $path "\\n" path
1265         return $path
1266 }
1267
1268 proc short_path {path} {
1269         return [escape_path [lindex [file split $path] end]]
1270 }
1271
1272 set next_icon_id 0
1273 set null_sha1 [string repeat 0 40]
1274
1275 proc merge_state {path new_state {head_info {}} {index_info {}}} {
1276         global file_states next_icon_id null_sha1
1277
1278         set s0 [string index $new_state 0]
1279         set s1 [string index $new_state 1]
1280
1281         if {[catch {set info $file_states($path)}]} {
1282                 set state __
1283                 set icon n[incr next_icon_id]
1284         } else {
1285                 set state [lindex $info 0]
1286                 set icon [lindex $info 1]
1287                 if {$head_info eq {}}  {set head_info  [lindex $info 2]}
1288                 if {$index_info eq {}} {set index_info [lindex $info 3]}
1289         }
1290
1291         if     {$s0 eq {?}} {set s0 [string index $state 0]} \
1292         elseif {$s0 eq {_}} {set s0 _}
1293
1294         if     {$s1 eq {?}} {set s1 [string index $state 1]} \
1295         elseif {$s1 eq {_}} {set s1 _}
1296
1297         if {$s0 eq {A} && $s1 eq {_} && $head_info eq {}} {
1298                 set head_info [list 0 $null_sha1]
1299         } elseif {$s0 ne {_} && [string index $state 0] eq {_}
1300                 && $head_info eq {}} {
1301                 set head_info $index_info
1302         }
1303
1304         set file_states($path) [list $s0$s1 $icon \
1305                 $head_info $index_info \
1306                 ]
1307         return $state
1308 }
1309
1310 proc display_file {path state} {
1311         global file_states file_lists selected_paths
1312
1313         set old_m [merge_state $path $state]
1314         set s $file_states($path)
1315         set new_m [lindex $s 0]
1316         set new_w [mapcol $new_m $path]
1317         set old_w [mapcol $old_m $path]
1318         set new_icon [mapicon $new_m $path]
1319
1320         if {$new_m eq {__}} {
1321                 set lno [lsearch -sorted $file_lists($old_w) $path]
1322                 if {$lno >= 0} {
1323                         set file_lists($old_w) \
1324                                 [lreplace $file_lists($old_w) $lno $lno]
1325                         incr lno
1326                         $old_w conf -state normal
1327                         $old_w delete $lno.0 [expr {$lno + 1}].0
1328                         $old_w conf -state disabled
1329                 }
1330                 unset file_states($path)
1331                 catch {unset selected_paths($path)}
1332                 return
1333         }
1334
1335         if {$new_w ne $old_w} {
1336                 set lno [lsearch -sorted $file_lists($old_w) $path]
1337                 if {$lno >= 0} {
1338                         set file_lists($old_w) \
1339                                 [lreplace $file_lists($old_w) $lno $lno]
1340                         incr lno
1341                         $old_w conf -state normal
1342                         $old_w delete $lno.0 [expr {$lno + 1}].0
1343                         $old_w conf -state disabled
1344                 }
1345
1346                 lappend file_lists($new_w) $path
1347                 set file_lists($new_w) [lsort $file_lists($new_w)]
1348                 set lno [lsearch -sorted $file_lists($new_w) $path]
1349                 incr lno
1350                 $new_w conf -state normal
1351                 $new_w image create $lno.0 \
1352                         -align center -padx 5 -pady 1 \
1353                         -name [lindex $s 1] \
1354                         -image $new_icon
1355                 $new_w insert $lno.1 "[escape_path $path]\n"
1356                 if {[catch {set in_sel $selected_paths($path)}]} {
1357                         set in_sel 0
1358                 }
1359                 if {$in_sel} {
1360                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1361                 }
1362                 $new_w conf -state disabled
1363         } elseif {$new_icon ne [mapicon $old_m $path]} {
1364                 $new_w conf -state normal
1365                 $new_w image conf [lindex $s 1] -image $new_icon
1366                 $new_w conf -state disabled
1367         }
1368 }
1369
1370 proc display_all_files {} {
1371         global ui_index ui_workdir
1372         global file_states file_lists
1373         global last_clicked selected_paths
1374
1375         $ui_index conf -state normal
1376         $ui_workdir conf -state normal
1377
1378         $ui_index delete 0.0 end
1379         $ui_workdir delete 0.0 end
1380         set last_clicked {}
1381
1382         set file_lists($ui_index) [list]
1383         set file_lists($ui_workdir) [list]
1384
1385         foreach path [lsort [array names file_states]] {
1386                 set s $file_states($path)
1387                 set m [lindex $s 0]
1388                 set w [mapcol $m $path]
1389                 lappend file_lists($w) $path
1390                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1391                 $w image create end \
1392                         -align center -padx 5 -pady 1 \
1393                         -name [lindex $s 1] \
1394                         -image [mapicon $m $path]
1395                 $w insert end "[escape_path $path]\n"
1396                 if {[catch {set in_sel $selected_paths($path)}]} {
1397                         set in_sel 0
1398                 }
1399                 if {$in_sel} {
1400                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1401                 }
1402         }
1403
1404         $ui_index conf -state disabled
1405         $ui_workdir conf -state disabled
1406 }
1407
1408 proc update_indexinfo {msg pathList after} {
1409         global update_index_cp ui_status_value
1410
1411         if {![lock_index update]} return
1412
1413         set update_index_cp 0
1414         set pathList [lsort $pathList]
1415         set totalCnt [llength $pathList]
1416         set batch [expr {int($totalCnt * .01) + 1}]
1417         if {$batch > 25} {set batch 25}
1418
1419         set ui_status_value [format \
1420                 "$msg... %i/%i files (%.2f%%)" \
1421                 $update_index_cp \
1422                 $totalCnt \
1423                 0.0]
1424         set fd [open "| git update-index -z --index-info" w]
1425         fconfigure $fd \
1426                 -blocking 0 \
1427                 -buffering full \
1428                 -buffersize 512 \
1429                 -translation binary
1430         fileevent $fd writable [list \
1431                 write_update_indexinfo \
1432                 $fd \
1433                 $pathList \
1434                 $totalCnt \
1435                 $batch \
1436                 $msg \
1437                 $after \
1438                 ]
1439 }
1440
1441 proc write_update_indexinfo {fd pathList totalCnt batch msg after} {
1442         global update_index_cp ui_status_value
1443         global file_states current_diff
1444
1445         if {$update_index_cp >= $totalCnt} {
1446                 close $fd
1447                 unlock_index
1448                 uplevel #0 $after
1449                 return
1450         }
1451
1452         for {set i $batch} \
1453                 {$update_index_cp < $totalCnt && $i > 0} \
1454                 {incr i -1} {
1455                 set path [lindex $pathList $update_index_cp]
1456                 incr update_index_cp
1457
1458                 set s $file_states($path)
1459                 switch -glob -- [lindex $s 0] {
1460                 A? {set new _O}
1461                 M? {set new _M}
1462                 D_ {set new _D}
1463                 D? {set new _?}
1464                 ?? {continue}
1465                 }
1466                 set info [lindex $s 2]
1467                 if {$info eq {}} continue
1468
1469                 puts -nonewline $fd $info
1470                 puts -nonewline $fd "\t"
1471                 puts -nonewline $fd $path
1472                 puts -nonewline $fd "\0"
1473                 display_file $path $new
1474         }
1475
1476         set ui_status_value [format \
1477                 "$msg... %i/%i files (%.2f%%)" \
1478                 $update_index_cp \
1479                 $totalCnt \
1480                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1481 }
1482
1483 proc update_index {msg pathList after} {
1484         global update_index_cp ui_status_value
1485
1486         if {![lock_index update]} return
1487
1488         set update_index_cp 0
1489         set pathList [lsort $pathList]
1490         set totalCnt [llength $pathList]
1491         set batch [expr {int($totalCnt * .01) + 1}]
1492         if {$batch > 25} {set batch 25}
1493
1494         set ui_status_value [format \
1495                 "$msg... %i/%i files (%.2f%%)" \
1496                 $update_index_cp \
1497                 $totalCnt \
1498                 0.0]
1499         set fd [open "| git update-index --add --remove -z --stdin" w]
1500         fconfigure $fd \
1501                 -blocking 0 \
1502                 -buffering full \
1503                 -buffersize 512 \
1504                 -translation binary
1505         fileevent $fd writable [list \
1506                 write_update_index \
1507                 $fd \
1508                 $pathList \
1509                 $totalCnt \
1510                 $batch \
1511                 $msg \
1512                 $after \
1513                 ]
1514 }
1515
1516 proc write_update_index {fd pathList totalCnt batch msg after} {
1517         global update_index_cp ui_status_value
1518         global file_states current_diff
1519
1520         if {$update_index_cp >= $totalCnt} {
1521                 close $fd
1522                 unlock_index
1523                 uplevel #0 $after
1524                 return
1525         }
1526
1527         for {set i $batch} \
1528                 {$update_index_cp < $totalCnt && $i > 0} \
1529                 {incr i -1} {
1530                 set path [lindex $pathList $update_index_cp]
1531                 incr update_index_cp
1532
1533                 switch -glob -- [lindex $file_states($path) 0] {
1534                 AD -
1535                 MD -
1536                 UD -
1537                 _D {set new DD}
1538
1539                 _M -
1540                 MM -
1541                 UM -
1542                 U_ -
1543                 M_ {set new M_}
1544
1545                 _O -
1546                 AM -
1547                 A_ {set new A_}
1548
1549                 ?? {continue}
1550                 }
1551
1552                 puts -nonewline $fd $path
1553                 puts -nonewline $fd "\0"
1554                 display_file $path $new
1555         }
1556
1557         set ui_status_value [format \
1558                 "$msg... %i/%i files (%.2f%%)" \
1559                 $update_index_cp \
1560                 $totalCnt \
1561                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1562 }
1563
1564 proc checkout_index {msg pathList after} {
1565         global update_index_cp ui_status_value
1566
1567         if {![lock_index update]} return
1568
1569         set update_index_cp 0
1570         set pathList [lsort $pathList]
1571         set totalCnt [llength $pathList]
1572         set batch [expr {int($totalCnt * .01) + 1}]
1573         if {$batch > 25} {set batch 25}
1574
1575         set ui_status_value [format \
1576                 "$msg... %i/%i files (%.2f%%)" \
1577                 $update_index_cp \
1578                 $totalCnt \
1579                 0.0]
1580         set cmd [list git checkout-index]
1581         lappend cmd --index
1582         lappend cmd --quiet
1583         lappend cmd --force
1584         lappend cmd -z
1585         lappend cmd --stdin
1586         set fd [open "| $cmd " w]
1587         fconfigure $fd \
1588                 -blocking 0 \
1589                 -buffering full \
1590                 -buffersize 512 \
1591                 -translation binary
1592         fileevent $fd writable [list \
1593                 write_checkout_index \
1594                 $fd \
1595                 $pathList \
1596                 $totalCnt \
1597                 $batch \
1598                 $msg \
1599                 $after \
1600                 ]
1601 }
1602
1603 proc write_checkout_index {fd pathList totalCnt batch msg after} {
1604         global update_index_cp ui_status_value
1605         global file_states current_diff
1606
1607         if {$update_index_cp >= $totalCnt} {
1608                 close $fd
1609                 unlock_index
1610                 uplevel #0 $after
1611                 return
1612         }
1613
1614         for {set i $batch} \
1615                 {$update_index_cp < $totalCnt && $i > 0} \
1616                 {incr i -1} {
1617                 set path [lindex $pathList $update_index_cp]
1618                 incr update_index_cp
1619
1620                 switch -glob -- [lindex $file_states($path) 0] {
1621                 AM -
1622                 AD {set new A_}
1623                 MM -
1624                 MD {set new M_}
1625                 _M -
1626                 _D {set new __}
1627                 ?? {continue}
1628                 }
1629
1630                 puts -nonewline $fd $path
1631                 puts -nonewline $fd "\0"
1632                 display_file $path $new
1633         }
1634
1635         set ui_status_value [format \
1636                 "$msg... %i/%i files (%.2f%%)" \
1637                 $update_index_cp \
1638                 $totalCnt \
1639                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1640 }
1641
1642 ######################################################################
1643 ##
1644 ## branch management
1645
1646 proc load_all_heads {} {
1647         global all_heads tracking_branches
1648
1649         set all_heads [list]
1650         set cmd [list git for-each-ref]
1651         lappend cmd --format=%(refname)
1652         lappend cmd refs/heads
1653         set fd [open "| $cmd" r]
1654         while {[gets $fd line] > 0} {
1655                 if {![catch {set info $tracking_branches($line)}]} continue
1656                 if {![regsub ^refs/heads/ $line {} name]} continue
1657                 lappend all_heads $name
1658         }
1659         close $fd
1660
1661         set all_heads [lsort $all_heads]
1662 }
1663
1664 proc populate_branch_menu {m} {
1665         global all_heads disable_on_lock
1666
1667         $m add separator
1668         foreach b $all_heads {
1669                 $m add radiobutton \
1670                         -label $b \
1671                         -command [list switch_branch $b] \
1672                         -variable current_branch \
1673                         -value $b \
1674                         -font font_ui
1675                 lappend disable_on_lock \
1676                         [list $m entryconf [$m index last] -state]
1677         }
1678 }
1679
1680 proc do_create_branch {} {
1681         error "NOT IMPLEMENTED"
1682 }
1683
1684 proc do_delete_branch {} {
1685         error "NOT IMPLEMENTED"
1686 }
1687
1688 proc switch_branch {b} {
1689         global HEAD commit_type file_states current_branch
1690         global selected_commit_type ui_comm
1691
1692         if {![lock_index switch]} return
1693
1694         # -- Backup the selected branch (repository_state resets it)
1695         #
1696         set new_branch $current_branch
1697
1698         # -- Our in memory state should match the repository.
1699         #
1700         repository_state curType curHEAD curMERGE_HEAD
1701         if {[string match amend* $commit_type]
1702                 && $curType eq {normal}
1703                 && $curHEAD eq $HEAD} {
1704         } elseif {$commit_type ne $curType || $HEAD ne $curHEAD} {
1705                 info_popup {Last scanned state does not match repository state.
1706
1707 Another Git program has modified this repository
1708 since the last scan.  A rescan must be performed
1709 before the current branch can be changed.
1710
1711 The rescan will be automatically started now.
1712 }
1713                 unlock_index
1714                 rescan {set ui_status_value {Ready.}}
1715                 return
1716         }
1717
1718         # -- Toss the message buffer if we are in amend mode.
1719         #
1720         if {[string match amend* $curType]} {
1721                 $ui_comm delete 0.0 end
1722                 $ui_comm edit reset
1723                 $ui_comm edit modified false
1724         }
1725
1726         set selected_commit_type new
1727         set current_branch $new_branch
1728
1729         unlock_index
1730         error "NOT FINISHED"
1731 }
1732
1733 ######################################################################
1734 ##
1735 ## remote management
1736
1737 proc load_all_remotes {} {
1738         global repo_config
1739         global all_remotes tracking_branches
1740
1741         set all_remotes [list]
1742         array unset tracking_branches
1743
1744         set rm_dir [gitdir remotes]
1745         if {[file isdirectory $rm_dir]} {
1746                 set all_remotes [glob \
1747                         -types f \
1748                         -tails \
1749                         -nocomplain \
1750                         -directory $rm_dir *]
1751
1752                 foreach name $all_remotes {
1753                         catch {
1754                                 set fd [open [file join $rm_dir $name] r]
1755                                 while {[gets $fd line] >= 0} {
1756                                         if {![regexp {^Pull:[   ]*([^:]+):(.+)$} \
1757                                                 $line line src dst]} continue
1758                                         if {![regexp ^refs/ $dst]} {
1759                                                 set dst "refs/heads/$dst"
1760                                         }
1761                                         set tracking_branches($dst) [list $name $src]
1762                                 }
1763                                 close $fd
1764                         }
1765                 }
1766         }
1767
1768         foreach line [array names repo_config remote.*.url] {
1769                 if {![regexp ^remote\.(.*)\.url\$ $line line name]} continue
1770                 lappend all_remotes $name
1771
1772                 if {[catch {set fl $repo_config(remote.$name.fetch)}]} {
1773                         set fl {}
1774                 }
1775                 foreach line $fl {
1776                         if {![regexp {^([^:]+):(.+)$} $line line src dst]} continue
1777                         if {![regexp ^refs/ $dst]} {
1778                                 set dst "refs/heads/$dst"
1779                         }
1780                         set tracking_branches($dst) [list $name $src]
1781                 }
1782         }
1783
1784         set all_remotes [lsort -unique $all_remotes]
1785 }
1786
1787 proc populate_fetch_menu {m} {
1788         global all_remotes repo_config
1789
1790         foreach r $all_remotes {
1791                 set enable 0
1792                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1793                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1794                                 set enable 1
1795                         }
1796                 } else {
1797                         catch {
1798                                 set fd [open [gitdir remotes $r] r]
1799                                 while {[gets $fd n] >= 0} {
1800                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1801                                                 set enable 1
1802                                                 break
1803                                         }
1804                                 }
1805                                 close $fd
1806                         }
1807                 }
1808
1809                 if {$enable} {
1810                         $m add command \
1811                                 -label "Fetch from $r..." \
1812                                 -command [list fetch_from $r] \
1813                                 -font font_ui
1814                 }
1815         }
1816 }
1817
1818 proc populate_push_menu {m} {
1819         global all_remotes repo_config
1820
1821         foreach r $all_remotes {
1822                 set enable 0
1823                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1824                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1825                                 set enable 1
1826                         }
1827                 } else {
1828                         catch {
1829                                 set fd [open [gitdir remotes $r] r]
1830                                 while {[gets $fd n] >= 0} {
1831                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1832                                                 set enable 1
1833                                                 break
1834                                         }
1835                                 }
1836                                 close $fd
1837                         }
1838                 }
1839
1840                 if {$enable} {
1841                         $m add command \
1842                                 -label "Push to $r..." \
1843                                 -command [list push_to $r] \
1844                                 -font font_ui
1845                 }
1846         }
1847 }
1848
1849 proc populate_pull_menu {m} {
1850         global repo_config all_remotes disable_on_lock
1851
1852         foreach remote $all_remotes {
1853                 set rb_list [list]
1854                 if {[array get repo_config remote.$remote.url] ne {}} {
1855                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1856                                 foreach line $repo_config(remote.$remote.fetch) {
1857                                         if {[regexp {^([^:]+):} $line line rb]} {
1858                                                 lappend rb_list $rb
1859                                         }
1860                                 }
1861                         }
1862                 } else {
1863                         catch {
1864                                 set fd [open [gitdir remotes $remote] r]
1865                                 while {[gets $fd line] >= 0} {
1866                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1867                                                 lappend rb_list $rb
1868                                         }
1869                                 }
1870                                 close $fd
1871                         }
1872                 }
1873
1874                 foreach rb $rb_list {
1875                         regsub ^refs/heads/ $rb {} rb_short
1876                         $m add command \
1877                                 -label "Branch $rb_short from $remote..." \
1878                                 -command [list pull_remote $remote $rb] \
1879                                 -font font_ui
1880                         lappend disable_on_lock \
1881                                 [list $m entryconf [$m index last] -state]
1882                 }
1883         }
1884 }
1885
1886 ######################################################################
1887 ##
1888 ## icons
1889
1890 set filemask {
1891 #define mask_width 14
1892 #define mask_height 15
1893 static unsigned char mask_bits[] = {
1894    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1895    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1896    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1897 }
1898
1899 image create bitmap file_plain -background white -foreground black -data {
1900 #define plain_width 14
1901 #define plain_height 15
1902 static unsigned char plain_bits[] = {
1903    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1904    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1905    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1906 } -maskdata $filemask
1907
1908 image create bitmap file_mod -background white -foreground blue -data {
1909 #define mod_width 14
1910 #define mod_height 15
1911 static unsigned char mod_bits[] = {
1912    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1913    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1914    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1915 } -maskdata $filemask
1916
1917 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1918 #define file_fulltick_width 14
1919 #define file_fulltick_height 15
1920 static unsigned char file_fulltick_bits[] = {
1921    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1922    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1923    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1924 } -maskdata $filemask
1925
1926 image create bitmap file_parttick -background white -foreground "#005050" -data {
1927 #define parttick_width 14
1928 #define parttick_height 15
1929 static unsigned char parttick_bits[] = {
1930    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1931    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1932    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1933 } -maskdata $filemask
1934
1935 image create bitmap file_question -background white -foreground black -data {
1936 #define file_question_width 14
1937 #define file_question_height 15
1938 static unsigned char file_question_bits[] = {
1939    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1940    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1941    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1942 } -maskdata $filemask
1943
1944 image create bitmap file_removed -background white -foreground red -data {
1945 #define file_removed_width 14
1946 #define file_removed_height 15
1947 static unsigned char file_removed_bits[] = {
1948    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1949    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1950    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1951 } -maskdata $filemask
1952
1953 image create bitmap file_merge -background white -foreground blue -data {
1954 #define file_merge_width 14
1955 #define file_merge_height 15
1956 static unsigned char file_merge_bits[] = {
1957    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1958    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1959    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1960 } -maskdata $filemask
1961
1962 set ui_index .vpane.files.index.list
1963 set ui_workdir .vpane.files.workdir.list
1964 set max_status_desc 0
1965 foreach i {
1966                 {__ i plain    "Unmodified"}
1967                 {_M i mod      "Modified"}
1968                 {M_ i fulltick "Added to commit"}
1969                 {MM i parttick "Partially included"}
1970                 {MD i question "Added (but gone)"}
1971
1972                 {_O o plain    "Untracked"}
1973                 {A_ o fulltick "Added by commit"}
1974                 {AM o parttick "Partially added"}
1975                 {AD o question "Added (but gone)"}
1976
1977                 {_D i question "Missing"}
1978                 {DD i removed  "Removed by commit"}
1979                 {D_ i removed  "Removed by commit"}
1980                 {DO i removed  "Removed (still exists)"}
1981                 {DM i removed  "Removed (but modified)"}
1982
1983                 {UD i merge    "Merge conflicts"}
1984                 {UM i merge    "Merge conflicts"}
1985                 {U_ i merge    "Merge conflicts"}
1986         } {
1987         if {$max_status_desc < [string length [lindex $i 3]]} {
1988                 set max_status_desc [string length [lindex $i 3]]
1989         }
1990         if {[lindex $i 1] eq {i}} {
1991                 set all_cols([lindex $i 0]) $ui_index
1992         } else {
1993                 set all_cols([lindex $i 0]) $ui_workdir
1994         }
1995         set all_icons([lindex $i 0]) file_[lindex $i 2]
1996         set all_descs([lindex $i 0]) [lindex $i 3]
1997 }
1998 unset filemask i
1999
2000 ######################################################################
2001 ##
2002 ## util
2003
2004 proc is_MacOSX {} {
2005         global tcl_platform tk_library
2006         if {[tk windowingsystem] eq {aqua}} {
2007                 return 1
2008         }
2009         return 0
2010 }
2011
2012 proc is_Windows {} {
2013         global tcl_platform
2014         if {$tcl_platform(platform) eq {windows}} {
2015                 return 1
2016         }
2017         return 0
2018 }
2019
2020 proc bind_button3 {w cmd} {
2021         bind $w <Any-Button-3> $cmd
2022         if {[is_MacOSX]} {
2023                 bind $w <Control-Button-1> $cmd
2024         }
2025 }
2026
2027 proc incr_font_size {font {amt 1}} {
2028         set sz [font configure $font -size]
2029         incr sz $amt
2030         font configure $font -size $sz
2031         font configure ${font}bold -size $sz
2032 }
2033
2034 proc hook_failed_popup {hook msg} {
2035         set w .hookfail
2036         toplevel $w
2037
2038         frame $w.m
2039         label $w.m.l1 -text "$hook hook failed:" \
2040                 -anchor w \
2041                 -justify left \
2042                 -font font_uibold
2043         text $w.m.t \
2044                 -background white -borderwidth 1 \
2045                 -relief sunken \
2046                 -width 80 -height 10 \
2047                 -font font_diff \
2048                 -yscrollcommand [list $w.m.sby set]
2049         label $w.m.l2 \
2050                 -text {You must correct the above errors before committing.} \
2051                 -anchor w \
2052                 -justify left \
2053                 -font font_uibold
2054         scrollbar $w.m.sby -command [list $w.m.t yview]
2055         pack $w.m.l1 -side top -fill x
2056         pack $w.m.l2 -side bottom -fill x
2057         pack $w.m.sby -side right -fill y
2058         pack $w.m.t -side left -fill both -expand 1
2059         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2060
2061         $w.m.t insert 1.0 $msg
2062         $w.m.t conf -state disabled
2063
2064         button $w.ok -text OK \
2065                 -width 15 \
2066                 -font font_ui \
2067                 -command "destroy $w"
2068         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2069
2070         bind $w <Visibility> "grab $w; focus $w"
2071         bind $w <Key-Return> "destroy $w"
2072         wm title $w "[appname] ([reponame]): error"
2073         tkwait window $w
2074 }
2075
2076 set next_console_id 0
2077
2078 proc new_console {short_title long_title} {
2079         global next_console_id console_data
2080         set w .console[incr next_console_id]
2081         set console_data($w) [list $short_title $long_title]
2082         return [console_init $w]
2083 }
2084
2085 proc console_init {w} {
2086         global console_cr console_data M1B
2087
2088         set console_cr($w) 1.0
2089         toplevel $w
2090         frame $w.m
2091         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
2092                 -anchor w \
2093                 -justify left \
2094                 -font font_uibold
2095         text $w.m.t \
2096                 -background white -borderwidth 1 \
2097                 -relief sunken \
2098                 -width 80 -height 10 \
2099                 -font font_diff \
2100                 -state disabled \
2101                 -yscrollcommand [list $w.m.sby set]
2102         label $w.m.s -text {Working... please wait...} \
2103                 -anchor w \
2104                 -justify left \
2105                 -font font_uibold
2106         scrollbar $w.m.sby -command [list $w.m.t yview]
2107         pack $w.m.l1 -side top -fill x
2108         pack $w.m.s -side bottom -fill x
2109         pack $w.m.sby -side right -fill y
2110         pack $w.m.t -side left -fill both -expand 1
2111         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
2112
2113         menu $w.ctxm -tearoff 0
2114         $w.ctxm add command -label "Copy" \
2115                 -font font_ui \
2116                 -command "tk_textCopy $w.m.t"
2117         $w.ctxm add command -label "Select All" \
2118                 -font font_ui \
2119                 -command "$w.m.t tag add sel 0.0 end"
2120         $w.ctxm add command -label "Copy All" \
2121                 -font font_ui \
2122                 -command "
2123                         $w.m.t tag add sel 0.0 end
2124                         tk_textCopy $w.m.t
2125                         $w.m.t tag remove sel 0.0 end
2126                 "
2127
2128         button $w.ok -text {Close} \
2129                 -font font_ui \
2130                 -state disabled \
2131                 -command "destroy $w"
2132         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
2133
2134         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
2135         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2136         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2137         bind $w <Visibility> "focus $w"
2138         wm title $w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2139         return $w
2140 }
2141
2142 proc console_exec {w cmd {after {}}} {
2143         # -- Windows tosses the enviroment when we exec our child.
2144         #    But most users need that so we have to relogin. :-(
2145         #
2146         if {[is_Windows]} {
2147                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
2148         }
2149
2150         # -- Tcl won't let us redirect both stdout and stderr to
2151         #    the same pipe.  So pass it through cat...
2152         #
2153         set cmd [concat | $cmd |& cat]
2154
2155         set fd_f [open $cmd r]
2156         fconfigure $fd_f -blocking 0 -translation binary
2157         fileevent $fd_f readable [list console_read $w $fd_f $after]
2158 }
2159
2160 proc console_read {w fd after} {
2161         global console_cr console_data
2162
2163         set buf [read $fd]
2164         if {$buf ne {}} {
2165                 if {![winfo exists $w]} {console_init $w}
2166                 $w.m.t conf -state normal
2167                 set c 0
2168                 set n [string length $buf]
2169                 while {$c < $n} {
2170                         set cr [string first "\r" $buf $c]
2171                         set lf [string first "\n" $buf $c]
2172                         if {$cr < 0} {set cr [expr {$n + 1}]}
2173                         if {$lf < 0} {set lf [expr {$n + 1}]}
2174
2175                         if {$lf < $cr} {
2176                                 $w.m.t insert end [string range $buf $c $lf]
2177                                 set console_cr($w) [$w.m.t index {end -1c}]
2178                                 set c $lf
2179                                 incr c
2180                         } else {
2181                                 $w.m.t delete $console_cr($w) end
2182                                 $w.m.t insert end "\n"
2183                                 $w.m.t insert end [string range $buf $c $cr]
2184                                 set c $cr
2185                                 incr c
2186                         }
2187                 }
2188                 $w.m.t conf -state disabled
2189                 $w.m.t see end
2190         }
2191
2192         fconfigure $fd -blocking 1
2193         if {[eof $fd]} {
2194                 if {[catch {close $fd}]} {
2195                         if {![winfo exists $w]} {console_init $w}
2196                         $w.m.s conf -background red -text {Error: Command Failed}
2197                         $w.ok conf -state normal
2198                         set ok 0
2199                 } elseif {[winfo exists $w]} {
2200                         $w.m.s conf -background green -text {Success}
2201                         $w.ok conf -state normal
2202                         set ok 1
2203                 }
2204                 array unset console_cr $w
2205                 array unset console_data $w
2206                 if {$after ne {}} {
2207                         uplevel #0 $after $ok
2208                 }
2209                 return
2210         }
2211         fconfigure $fd -blocking 0
2212 }
2213
2214 ######################################################################
2215 ##
2216 ## ui commands
2217
2218 set starting_gitk_msg {Starting gitk... please wait...}
2219
2220 proc do_gitk {revs} {
2221         global ui_status_value starting_gitk_msg
2222
2223         set cmd gitk
2224         if {$revs ne {}} {
2225                 append cmd { }
2226                 append cmd $revs
2227         }
2228         if {[is_Windows]} {
2229                 set cmd "sh -c \"exec $cmd\""
2230         }
2231         append cmd { &}
2232
2233         if {[catch {eval exec $cmd} err]} {
2234                 error_popup "Failed to start gitk:\n\n$err"
2235         } else {
2236                 set ui_status_value $starting_gitk_msg
2237                 after 10000 {
2238                         if {$ui_status_value eq $starting_gitk_msg} {
2239                                 set ui_status_value {Ready.}
2240                         }
2241                 }
2242         }
2243 }
2244
2245 proc do_gc {} {
2246         set w [new_console {gc} {Compressing the object database}]
2247         console_exec $w {git gc}
2248 }
2249
2250 proc do_fsck_objects {} {
2251         set w [new_console {fsck-objects} \
2252                 {Verifying the object database with fsck-objects}]
2253         set cmd [list git fsck-objects]
2254         lappend cmd --full
2255         lappend cmd --cache
2256         lappend cmd --strict
2257         console_exec $w $cmd
2258 }
2259
2260 set is_quitting 0
2261
2262 proc do_quit {} {
2263         global ui_comm is_quitting repo_config commit_type
2264
2265         if {$is_quitting} return
2266         set is_quitting 1
2267
2268         # -- Stash our current commit buffer.
2269         #
2270         set save [gitdir GITGUI_MSG]
2271         set msg [string trim [$ui_comm get 0.0 end]]
2272         if {![string match amend* $commit_type]
2273                 && [$ui_comm edit modified]
2274                 && $msg ne {}} {
2275                 catch {
2276                         set fd [open $save w]
2277                         puts $fd [string trim [$ui_comm get 0.0 end]]
2278                         close $fd
2279                 }
2280         } else {
2281                 catch {file delete $save}
2282         }
2283
2284         # -- Stash our current window geometry into this repository.
2285         #
2286         set cfg_geometry [list]
2287         lappend cfg_geometry [wm geometry .]
2288         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
2289         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
2290         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
2291                 set rc_geometry {}
2292         }
2293         if {$cfg_geometry ne $rc_geometry} {
2294                 catch {exec git repo-config gui.geometry $cfg_geometry}
2295         }
2296
2297         destroy .
2298 }
2299
2300 proc do_rescan {} {
2301         rescan {set ui_status_value {Ready.}}
2302 }
2303
2304 proc remove_helper {txt paths} {
2305         global file_states current_diff
2306
2307         if {![lock_index begin-update]} return
2308
2309         set pathList [list]
2310         set after {}
2311         foreach path $paths {
2312                 switch -glob -- [lindex $file_states($path) 0] {
2313                 A? -
2314                 M? -
2315                 D? {
2316                         lappend pathList $path
2317                         if {$path eq $current_diff} {
2318                                 set after {reshow_diff;}
2319                         }
2320                 }
2321                 }
2322         }
2323         if {$pathList eq {}} {
2324                 unlock_index
2325         } else {
2326                 update_indexinfo \
2327                         $txt \
2328                         $pathList \
2329                         [concat $after {set ui_status_value {Ready.}}]
2330         }
2331 }
2332
2333 proc do_remove_selection {} {
2334         global current_diff selected_paths
2335
2336         if {[array size selected_paths] > 0} {
2337                 remove_helper \
2338                         {Removing selected files from commit} \
2339                         [array names selected_paths]
2340         } elseif {$current_diff ne {}} {
2341                 remove_helper \
2342                         "Removing [short_path $current_diff] from commit" \
2343                         [list $current_diff]
2344         }
2345 }
2346
2347 proc include_helper {txt paths} {
2348         global file_states current_diff
2349
2350         if {![lock_index begin-update]} return
2351
2352         set pathList [list]
2353         set after {}
2354         foreach path $paths {
2355                 switch -glob -- [lindex $file_states($path) 0] {
2356                 AM -
2357                 AD -
2358                 MM -
2359                 MD -
2360                 U? -
2361                 _M -
2362                 _D -
2363                 _O {
2364                         lappend pathList $path
2365                         if {$path eq $current_diff} {
2366                                 set after {reshow_diff;}
2367                         }
2368                 }
2369                 }
2370         }
2371         if {$pathList eq {}} {
2372                 unlock_index
2373         } else {
2374                 update_index \
2375                         $txt \
2376                         $pathList \
2377                         [concat $after {set ui_status_value {Ready to commit.}}]
2378         }
2379 }
2380
2381 proc do_include_selection {} {
2382         global current_diff selected_paths
2383
2384         if {[array size selected_paths] > 0} {
2385                 include_helper \
2386                         {Adding selected files} \
2387                         [array names selected_paths]
2388         } elseif {$current_diff ne {}} {
2389                 include_helper \
2390                         "Adding [short_path $current_diff]" \
2391                         [list $current_diff]
2392         }
2393 }
2394
2395 proc do_include_all {} {
2396         global file_states
2397
2398         set paths [list]
2399         foreach path [array names file_states] {
2400                 switch -- [lindex $file_states($path) 0] {
2401                 AM -
2402                 AD -
2403                 MM -
2404                 MD -
2405                 _M -
2406                 _D {lappend paths $path}
2407                 }
2408         }
2409         include_helper \
2410                 {Adding all modified files} \
2411                 $paths
2412 }
2413
2414 proc revert_helper {txt paths} {
2415         global file_states current_diff
2416
2417         if {![lock_index begin-update]} return
2418
2419         set pathList [list]
2420         set after {}
2421         foreach path $paths {
2422                 switch -glob -- [lindex $file_states($path) 0] {
2423                 AM -
2424                 AD -
2425                 MM -
2426                 MD -
2427                 _M -
2428                 _D {
2429                         lappend pathList $path
2430                         if {$path eq $current_diff} {
2431                                 set after {reshow_diff;}
2432                         }
2433                 }
2434                 }
2435         }
2436
2437         set n [llength $pathList]
2438         if {$n == 0} {
2439                 unlock_index
2440                 return
2441         } elseif {$n == 1} {
2442                 set s "[short_path [lindex $pathList]]"
2443         } else {
2444                 set s "these $n files"
2445         }
2446
2447         set reply [tk_dialog \
2448                 .confirm_revert \
2449                 "[appname] ([reponame])" \
2450                 "Revert changes in $s?
2451
2452 Any unadded changes will be permanently lost by the revert." \
2453                 question \
2454                 1 \
2455                 {Do Nothing} \
2456                 {Revert Changes} \
2457                 ]
2458         if {$reply == 1} {
2459                 checkout_index \
2460                         $txt \
2461                         $pathList \
2462                         [concat $after {set ui_status_value {Ready.}}]
2463         } else {
2464                 unlock_index
2465         }
2466 }
2467
2468 proc do_revert_selection {} {
2469         global current_diff selected_paths
2470
2471         if {[array size selected_paths] > 0} {
2472                 revert_helper \
2473                         {Reverting selected files} \
2474                         [array names selected_paths]
2475         } elseif {$current_diff ne {}} {
2476                 revert_helper \
2477                         "Reverting [short_path $current_diff]" \
2478                         [list $current_diff]
2479         }
2480 }
2481
2482 proc do_signoff {} {
2483         global ui_comm
2484
2485         set me [committer_ident]
2486         if {$me eq {}} return
2487
2488         set sob "Signed-off-by: $me"
2489         set last [$ui_comm get {end -1c linestart} {end -1c}]
2490         if {$last ne $sob} {
2491                 $ui_comm edit separator
2492                 if {$last ne {}
2493                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
2494                         $ui_comm insert end "\n"
2495                 }
2496                 $ui_comm insert end "\n$sob"
2497                 $ui_comm edit separator
2498                 $ui_comm see end
2499         }
2500 }
2501
2502 proc do_select_commit_type {} {
2503         global commit_type selected_commit_type
2504
2505         if {$selected_commit_type eq {new}
2506                 && [string match amend* $commit_type]} {
2507                 create_new_commit
2508         } elseif {$selected_commit_type eq {amend}
2509                 && ![string match amend* $commit_type]} {
2510                 load_last_commit
2511
2512                 # The amend request was rejected...
2513                 #
2514                 if {![string match amend* $commit_type]} {
2515                         set selected_commit_type new
2516                 }
2517         }
2518 }
2519
2520 proc do_commit {} {
2521         commit_tree
2522 }
2523
2524 proc do_about {} {
2525         global appvers copyright
2526         global tcl_patchLevel tk_patchLevel
2527
2528         set w .about_dialog
2529         toplevel $w
2530         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2531
2532         label $w.header -text "About [appname]" \
2533                 -font font_uibold
2534         pack $w.header -side top -fill x
2535
2536         frame $w.buttons
2537         button $w.buttons.close -text {Close} \
2538                 -font font_ui \
2539                 -command [list destroy $w]
2540         pack $w.buttons.close -side right
2541         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2542
2543         label $w.desc \
2544                 -text "[appname] - a commit creation tool for Git.
2545 $copyright" \
2546                 -padx 5 -pady 5 \
2547                 -justify left \
2548                 -anchor w \
2549                 -borderwidth 1 \
2550                 -relief solid \
2551                 -font font_ui
2552         pack $w.desc -side top -fill x -padx 5 -pady 5
2553
2554         set v {}
2555         append v "[appname] version $appvers\n"
2556         append v "[exec git version]\n"
2557         append v "\n"
2558         if {$tcl_patchLevel eq $tk_patchLevel} {
2559                 append v "Tcl/Tk version $tcl_patchLevel"
2560         } else {
2561                 append v "Tcl version $tcl_patchLevel"
2562                 append v ", Tk version $tk_patchLevel"
2563         }
2564
2565         label $w.vers \
2566                 -text $v \
2567                 -padx 5 -pady 5 \
2568                 -justify left \
2569                 -anchor w \
2570                 -borderwidth 1 \
2571                 -relief solid \
2572                 -font font_ui
2573         pack $w.vers -side top -fill x -padx 5 -pady 5
2574
2575         menu $w.ctxm -tearoff 0
2576         $w.ctxm add command \
2577                 -label {Copy} \
2578                 -font font_ui \
2579                 -command "
2580                 clipboard clear
2581                 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2582         "
2583
2584         bind $w <Visibility> "grab $w; focus $w"
2585         bind $w <Key-Escape> "destroy $w"
2586         bind_button3 $w.vers "tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2587         wm title $w "About [appname]"
2588         tkwait window $w
2589 }
2590
2591 proc do_options {} {
2592         global repo_config global_config font_descs
2593         global repo_config_new global_config_new
2594
2595         array unset repo_config_new
2596         array unset global_config_new
2597         foreach name [array names repo_config] {
2598                 set repo_config_new($name) $repo_config($name)
2599         }
2600         load_config 1
2601         foreach name [array names repo_config] {
2602                 switch -- $name {
2603                 gui.diffcontext {continue}
2604                 }
2605                 set repo_config_new($name) $repo_config($name)
2606         }
2607         foreach name [array names global_config] {
2608                 set global_config_new($name) $global_config($name)
2609         }
2610
2611         set w .options_editor
2612         toplevel $w
2613         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
2614
2615         label $w.header -text "[appname] Options" \
2616                 -font font_uibold
2617         pack $w.header -side top -fill x
2618
2619         frame $w.buttons
2620         button $w.buttons.restore -text {Restore Defaults} \
2621                 -font font_ui \
2622                 -command do_restore_defaults
2623         pack $w.buttons.restore -side left
2624         button $w.buttons.save -text Save \
2625                 -font font_ui \
2626                 -command [list do_save_config $w]
2627         pack $w.buttons.save -side right
2628         button $w.buttons.cancel -text {Cancel} \
2629                 -font font_ui \
2630                 -command [list destroy $w]
2631         pack $w.buttons.cancel -side right
2632         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
2633
2634         labelframe $w.repo -text "[reponame] Repository" \
2635                 -font font_ui \
2636                 -relief raised -borderwidth 2
2637         labelframe $w.global -text {Global (All Repositories)} \
2638                 -font font_ui \
2639                 -relief raised -borderwidth 2
2640         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
2641         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
2642
2643         foreach option {
2644                 {b partialinclude {Allow Partially Added Files}}
2645                 {b pullsummary {Show Pull Summary}}
2646                 {b trustmtime  {Trust File Modification Timestamps}}
2647                 {i diffcontext {Number of Diff Context Lines}}
2648                 } {
2649                 set type [lindex $option 0]
2650                 set name [lindex $option 1]
2651                 set text [lindex $option 2]
2652                 foreach f {repo global} {
2653                         switch $type {
2654                         b {
2655                                 checkbutton $w.$f.$name -text $text \
2656                                         -variable ${f}_config_new(gui.$name) \
2657                                         -onvalue true \
2658                                         -offvalue false \
2659                                         -font font_ui
2660                                 pack $w.$f.$name -side top -anchor w
2661                         }
2662                         i {
2663                                 frame $w.$f.$name
2664                                 label $w.$f.$name.l -text "$text:" -font font_ui
2665                                 pack $w.$f.$name.l -side left -anchor w -fill x
2666                                 spinbox $w.$f.$name.v \
2667                                         -textvariable ${f}_config_new(gui.$name) \
2668                                         -from 1 -to 99 -increment 1 \
2669                                         -width 3 \
2670                                         -font font_ui
2671                                 pack $w.$f.$name.v -side right -anchor e
2672                                 pack $w.$f.$name -side top -anchor w -fill x
2673                         }
2674                         }
2675                 }
2676         }
2677
2678         set all_fonts [lsort [font families]]
2679         foreach option $font_descs {
2680                 set name [lindex $option 0]
2681                 set font [lindex $option 1]
2682                 set text [lindex $option 2]
2683
2684                 set global_config_new(gui.$font^^family) \
2685                         [font configure $font -family]
2686                 set global_config_new(gui.$font^^size) \
2687                         [font configure $font -size]
2688
2689                 frame $w.global.$name
2690                 label $w.global.$name.l -text "$text:" -font font_ui
2691                 pack $w.global.$name.l -side left -anchor w -fill x
2692                 eval tk_optionMenu $w.global.$name.family \
2693                         global_config_new(gui.$font^^family) \
2694                         $all_fonts
2695                 spinbox $w.global.$name.size \
2696                         -textvariable global_config_new(gui.$font^^size) \
2697                         -from 2 -to 80 -increment 1 \
2698                         -width 3 \
2699                         -font font_ui
2700                 pack $w.global.$name.size -side right -anchor e
2701                 pack $w.global.$name.family -side right -anchor e
2702                 pack $w.global.$name -side top -anchor w -fill x
2703         }
2704
2705         bind $w <Visibility> "grab $w; focus $w"
2706         bind $w <Key-Escape> "destroy $w"
2707         wm title $w "[appname] ([reponame]): Options"
2708         tkwait window $w
2709 }
2710
2711 proc do_restore_defaults {} {
2712         global font_descs default_config repo_config
2713         global repo_config_new global_config_new
2714
2715         foreach name [array names default_config] {
2716                 set repo_config_new($name) $default_config($name)
2717                 set global_config_new($name) $default_config($name)
2718         }
2719
2720         foreach option $font_descs {
2721                 set name [lindex $option 0]
2722                 set repo_config(gui.$name) $default_config(gui.$name)
2723         }
2724         apply_config
2725
2726         foreach option $font_descs {
2727                 set name [lindex $option 0]
2728                 set font [lindex $option 1]
2729                 set global_config_new(gui.$font^^family) \
2730                         [font configure $font -family]
2731                 set global_config_new(gui.$font^^size) \
2732                         [font configure $font -size]
2733         }
2734 }
2735
2736 proc do_save_config {w} {
2737         if {[catch {save_config} err]} {
2738                 error_popup "Failed to completely save options:\n\n$err"
2739         }
2740         reshow_diff
2741         destroy $w
2742 }
2743
2744 proc do_windows_shortcut {} {
2745         global argv0
2746
2747         if {[catch {
2748                 set desktop [exec cygpath \
2749                         --windows \
2750                         --absolute \
2751                         --long-name \
2752                         --desktop]
2753                 }]} {
2754                         set desktop .
2755         }
2756         set fn [tk_getSaveFile \
2757                 -parent . \
2758                 -title "[appname] ([reponame]): Create Desktop Icon" \
2759                 -initialdir $desktop \
2760                 -initialfile "Git [reponame].bat"]
2761         if {$fn != {}} {
2762                 if {[catch {
2763                                 set fd [open $fn w]
2764                                 set sh [exec cygpath \
2765                                         --windows \
2766                                         --absolute \
2767                                         /bin/sh]
2768                                 set me [exec cygpath \
2769                                         --unix \
2770                                         --absolute \
2771                                         $argv0]
2772                                 set gd [exec cygpath \
2773                                         --unix \
2774                                         --absolute \
2775                                         [gitdir]]
2776                                 set gw [exec cygpath \
2777                                         --windows \
2778                                         --absolute \
2779                                         [file dirname [gitdir]]]
2780                                 regsub -all ' $me "'\\''" me
2781                                 regsub -all ' $gd "'\\''" gd
2782                                 puts $fd "@ECHO Entering $gw"
2783                                 puts $fd "@ECHO Starting git-gui... please wait..."
2784                                 puts -nonewline $fd "@\"$sh\" --login -c \""
2785                                 puts -nonewline $fd "GIT_DIR='$gd'"
2786                                 puts -nonewline $fd " '$me'"
2787                                 puts $fd "&\""
2788                                 close $fd
2789                         } err]} {
2790                         error_popup "Cannot write script:\n\n$err"
2791                 }
2792         }
2793 }
2794
2795 proc do_macosx_app {} {
2796         global argv0 env
2797
2798         set fn [tk_getSaveFile \
2799                 -parent . \
2800                 -title "[appname] ([reponame]): Create Desktop Icon" \
2801                 -initialdir [file join $env(HOME) Desktop] \
2802                 -initialfile "Git [reponame].app"]
2803         if {$fn != {}} {
2804                 if {[catch {
2805                                 set Contents [file join $fn Contents]
2806                                 set MacOS [file join $Contents MacOS]
2807                                 set exe [file join $MacOS git-gui]
2808
2809                                 file mkdir $MacOS
2810
2811                                 set fd [open [file join $Contents Info.plist] w]
2812                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2813 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2814 <plist version="1.0">
2815 <dict>
2816         <key>CFBundleDevelopmentRegion</key>
2817         <string>English</string>
2818         <key>CFBundleExecutable</key>
2819         <string>git-gui</string>
2820         <key>CFBundleIdentifier</key>
2821         <string>org.spearce.git-gui</string>
2822         <key>CFBundleInfoDictionaryVersion</key>
2823         <string>6.0</string>
2824         <key>CFBundlePackageType</key>
2825         <string>APPL</string>
2826         <key>CFBundleSignature</key>
2827         <string>????</string>
2828         <key>CFBundleVersion</key>
2829         <string>1.0</string>
2830         <key>NSPrincipalClass</key>
2831         <string>NSApplication</string>
2832 </dict>
2833 </plist>}
2834                                 close $fd
2835
2836                                 set fd [open $exe w]
2837                                 set gd [file normalize [gitdir]]
2838                                 set ep [file normalize [exec git --exec-path]]
2839                                 regsub -all ' $gd "'\\''" gd
2840                                 regsub -all ' $ep "'\\''" ep
2841                                 puts $fd "#!/bin/sh"
2842                                 foreach name [array names env] {
2843                                         if {[string match GIT_* $name]} {
2844                                                 regsub -all ' $env($name) "'\\''" v
2845                                                 puts $fd "export $name='$v'"
2846                                         }
2847                                 }
2848                                 puts $fd "export PATH='$ep':\$PATH"
2849                                 puts $fd "export GIT_DIR='$gd'"
2850                                 puts $fd "exec [file normalize $argv0]"
2851                                 close $fd
2852
2853                                 file attributes $exe -permissions u+x,g+x,o+x
2854                         } err]} {
2855                         error_popup "Cannot write icon:\n\n$err"
2856                 }
2857         }
2858 }
2859
2860 proc toggle_or_diff {w x y} {
2861         global file_states file_lists current_diff ui_index ui_workdir
2862         global last_clicked selected_paths
2863
2864         set pos [split [$w index @$x,$y] .]
2865         set lno [lindex $pos 0]
2866         set col [lindex $pos 1]
2867         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2868         if {$path eq {}} {
2869                 set last_clicked {}
2870                 return
2871         }
2872
2873         set last_clicked [list $w $lno]
2874         array unset selected_paths
2875         $ui_index tag remove in_sel 0.0 end
2876         $ui_workdir tag remove in_sel 0.0 end
2877
2878         if {$col == 0} {
2879                 if {$current_diff eq $path} {
2880                         set after {reshow_diff;}
2881                 } else {
2882                         set after {}
2883                 }
2884                 switch -glob -- [lindex $file_states($path) 0] {
2885                 A_ -
2886                 M_ -
2887                 DD -
2888                 DO -
2889                 DM {
2890                         update_indexinfo \
2891                                 "Removing [short_path $path] from commit" \
2892                                 [list $path] \
2893                                 [concat $after {set ui_status_value {Ready.}}]
2894                 }
2895                 ?? {
2896                         update_index \
2897                                 "Adding [short_path $path]" \
2898                                 [list $path] \
2899                                 [concat $after {set ui_status_value {Ready.}}]
2900                 }
2901                 }
2902         } else {
2903                 show_diff $path $w $lno
2904         }
2905 }
2906
2907 proc add_one_to_selection {w x y} {
2908         global file_lists
2909         global last_clicked selected_paths
2910
2911         set pos [split [$w index @$x,$y] .]
2912         set lno [lindex $pos 0]
2913         set col [lindex $pos 1]
2914         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2915         if {$path eq {}} {
2916                 set last_clicked {}
2917                 return
2918         }
2919
2920         set last_clicked [list $w $lno]
2921         if {[catch {set in_sel $selected_paths($path)}]} {
2922                 set in_sel 0
2923         }
2924         if {$in_sel} {
2925                 unset selected_paths($path)
2926                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2927         } else {
2928                 set selected_paths($path) 1
2929                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2930         }
2931 }
2932
2933 proc add_range_to_selection {w x y} {
2934         global file_lists
2935         global last_clicked selected_paths
2936
2937         if {[lindex $last_clicked 0] ne $w} {
2938                 toggle_or_diff $w $x $y
2939                 return
2940         }
2941
2942         set pos [split [$w index @$x,$y] .]
2943         set lno [lindex $pos 0]
2944         set lc [lindex $last_clicked 1]
2945         if {$lc < $lno} {
2946                 set begin $lc
2947                 set end $lno
2948         } else {
2949                 set begin $lno
2950                 set end $lc
2951         }
2952
2953         foreach path [lrange $file_lists($w) \
2954                 [expr {$begin - 1}] \
2955                 [expr {$end - 1}]] {
2956                 set selected_paths($path) 1
2957         }
2958         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2959 }
2960
2961 ######################################################################
2962 ##
2963 ## config defaults
2964
2965 set cursor_ptr arrow
2966 font create font_diff -family Courier -size 10
2967 font create font_ui
2968 catch {
2969         label .dummy
2970         eval font configure font_ui [font actual [.dummy cget -font]]
2971         destroy .dummy
2972 }
2973
2974 font create font_uibold
2975 font create font_diffbold
2976
2977 if {[is_Windows]} {
2978         set M1B Control
2979         set M1T Ctrl
2980 } elseif {[is_MacOSX]} {
2981         set M1B M1
2982         set M1T Cmd
2983 } else {
2984         set M1B M1
2985         set M1T M1
2986 }
2987
2988 proc apply_config {} {
2989         global repo_config font_descs
2990
2991         foreach option $font_descs {
2992                 set name [lindex $option 0]
2993                 set font [lindex $option 1]
2994                 if {[catch {
2995                         foreach {cn cv} $repo_config(gui.$name) {
2996                                 font configure $font $cn $cv
2997                         }
2998                         } err]} {
2999                         error_popup "Invalid font specified in gui.$name:\n\n$err"
3000                 }
3001                 foreach {cn cv} [font configure $font] {
3002                         font configure ${font}bold $cn $cv
3003                 }
3004                 font configure ${font}bold -weight bold
3005         }
3006 }
3007
3008 set default_config(gui.trustmtime) false
3009 set default_config(gui.pullsummary) true
3010 set default_config(gui.partialinclude) false
3011 set default_config(gui.diffcontext) 5
3012 set default_config(gui.fontui) [font configure font_ui]
3013 set default_config(gui.fontdiff) [font configure font_diff]
3014 set font_descs {
3015         {fontui   font_ui   {Main Font}}
3016         {fontdiff font_diff {Diff/Console Font}}
3017 }
3018 load_config 0
3019 apply_config
3020
3021 ######################################################################
3022 ##
3023 ## ui construction
3024
3025 # -- Menu Bar
3026 #
3027 menu .mbar -tearoff 0
3028 .mbar add cascade -label Repository -menu .mbar.repository
3029 .mbar add cascade -label Edit -menu .mbar.edit
3030 if {!$single_commit} {
3031         .mbar add cascade -label Branch -menu .mbar.branch
3032 }
3033 .mbar add cascade -label Commit -menu .mbar.commit
3034 if {!$single_commit} {
3035         .mbar add cascade -label Fetch -menu .mbar.fetch
3036         .mbar add cascade -label Pull -menu .mbar.pull
3037         .mbar add cascade -label Push -menu .mbar.push
3038 }
3039 . configure -menu .mbar
3040
3041 # -- Repository Menu
3042 #
3043 menu .mbar.repository
3044 .mbar.repository add command \
3045         -label {Visualize Current Branch} \
3046         -command {do_gitk {}} \
3047         -font font_ui
3048 if {![is_MacOSX]} {
3049         .mbar.repository add command \
3050                 -label {Visualize All Branches} \
3051                 -command {do_gitk {--all}} \
3052                 -font font_ui
3053 }
3054 .mbar.repository add separator
3055
3056 if {!$single_commit} {
3057         .mbar.repository add command -label {Compress Database} \
3058                 -command do_gc \
3059                 -font font_ui
3060
3061         .mbar.repository add command -label {Verify Database} \
3062                 -command do_fsck_objects \
3063                 -font font_ui
3064
3065         .mbar.repository add separator
3066
3067         if {[is_Windows]} {
3068                 .mbar.repository add command \
3069                         -label {Create Desktop Icon} \
3070                         -command do_windows_shortcut \
3071                         -font font_ui
3072         } elseif {[is_MacOSX]} {
3073                 .mbar.repository add command \
3074                         -label {Create Desktop Icon} \
3075                         -command do_macosx_app \
3076                         -font font_ui
3077         }
3078 }
3079
3080 .mbar.repository add command -label Quit \
3081         -command do_quit \
3082         -accelerator $M1T-Q \
3083         -font font_ui
3084
3085 # -- Edit Menu
3086 #
3087 menu .mbar.edit
3088 .mbar.edit add command -label Undo \
3089         -command {catch {[focus] edit undo}} \
3090         -accelerator $M1T-Z \
3091         -font font_ui
3092 .mbar.edit add command -label Redo \
3093         -command {catch {[focus] edit redo}} \
3094         -accelerator $M1T-Y \
3095         -font font_ui
3096 .mbar.edit add separator
3097 .mbar.edit add command -label Cut \
3098         -command {catch {tk_textCut [focus]}} \
3099         -accelerator $M1T-X \
3100         -font font_ui
3101 .mbar.edit add command -label Copy \
3102         -command {catch {tk_textCopy [focus]}} \
3103         -accelerator $M1T-C \
3104         -font font_ui
3105 .mbar.edit add command -label Paste \
3106         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3107         -accelerator $M1T-V \
3108         -font font_ui
3109 .mbar.edit add command -label Delete \
3110         -command {catch {[focus] delete sel.first sel.last}} \
3111         -accelerator Del \
3112         -font font_ui
3113 .mbar.edit add separator
3114 .mbar.edit add command -label {Select All} \
3115         -command {catch {[focus] tag add sel 0.0 end}} \
3116         -accelerator $M1T-A \
3117         -font font_ui
3118
3119 # -- Branch Menu
3120 #
3121 if {!$single_commit} {
3122         menu .mbar.branch
3123
3124         .mbar.branch add command -label {Create...} \
3125                 -command do_create_branch \
3126                 -font font_ui
3127         lappend disable_on_lock [list .mbar.branch entryconf \
3128                 [.mbar.branch index last] -state]
3129
3130         .mbar.branch add command -label {Delete...} \
3131                 -command do_delete_branch \
3132                 -font font_ui
3133         lappend disable_on_lock [list .mbar.branch entryconf \
3134                 [.mbar.branch index last] -state]
3135 }
3136
3137 # -- Commit Menu
3138 #
3139 menu .mbar.commit
3140
3141 .mbar.commit add radiobutton \
3142         -label {New Commit} \
3143         -command do_select_commit_type \
3144         -variable selected_commit_type \
3145         -value new \
3146         -font font_ui
3147 lappend disable_on_lock \
3148         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3149
3150 .mbar.commit add radiobutton \
3151         -label {Amend Last Commit} \
3152         -command do_select_commit_type \
3153         -variable selected_commit_type \
3154         -value amend \
3155         -font font_ui
3156 lappend disable_on_lock \
3157         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3158
3159 .mbar.commit add separator
3160
3161 .mbar.commit add command -label Rescan \
3162         -command do_rescan \
3163         -accelerator F5 \
3164         -font font_ui
3165 lappend disable_on_lock \
3166         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3167
3168 .mbar.commit add command -label {Add To Commit} \
3169         -command do_include_selection \
3170         -font font_ui
3171 lappend disable_on_lock \
3172         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3173
3174 .mbar.commit add command -label {Add All To Commit} \
3175         -command do_include_all \
3176         -accelerator $M1T-I \
3177         -font font_ui
3178 lappend disable_on_lock \
3179         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3180
3181 .mbar.commit add command -label {Remove From Commit} \
3182         -command do_remove_selection \
3183         -font font_ui
3184 lappend disable_on_lock \
3185         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3186
3187 .mbar.commit add command -label {Revert Changes} \
3188         -command do_revert_selection \
3189         -font font_ui
3190 lappend disable_on_lock \
3191         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3192
3193 .mbar.commit add separator
3194
3195 .mbar.commit add command -label {Sign Off} \
3196         -command do_signoff \
3197         -accelerator $M1T-S \
3198         -font font_ui
3199
3200 .mbar.commit add command -label Commit \
3201         -command do_commit \
3202         -accelerator $M1T-Return \
3203         -font font_ui
3204 lappend disable_on_lock \
3205         [list .mbar.commit entryconf [.mbar.commit index last] -state]
3206
3207 # -- Transport menus
3208 #
3209 if {!$single_commit} {
3210         menu .mbar.fetch
3211         menu .mbar.pull
3212         menu .mbar.push
3213 }
3214
3215 if {[is_MacOSX]} {
3216         # -- Apple Menu (Mac OS X only)
3217         #
3218         .mbar add cascade -label Apple -menu .mbar.apple
3219         menu .mbar.apple
3220
3221         .mbar.apple add command -label "About [appname]" \
3222                 -command do_about \
3223                 -font font_ui
3224         .mbar.apple add command -label "[appname] Options..." \
3225                 -command do_options \
3226                 -font font_ui
3227 } else {
3228         # -- Edit Menu
3229         #
3230         .mbar.edit add separator
3231         .mbar.edit add command -label {Options...} \
3232                 -command do_options \
3233                 -font font_ui
3234
3235         # -- Tools Menu
3236         #
3237         if {[file exists /usr/local/miga/lib/gui-miga]
3238                 && [file exists .pvcsrc]} {
3239         proc do_miga {} {
3240                 global ui_status_value
3241                 if {![lock_index update]} return
3242                 set cmd [list sh --login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
3243                 set miga_fd [open "|$cmd" r]
3244                 fconfigure $miga_fd -blocking 0
3245                 fileevent $miga_fd readable [list miga_done $miga_fd]
3246                 set ui_status_value {Running miga...}
3247         }
3248         proc miga_done {fd} {
3249                 read $fd 512
3250                 if {[eof $fd]} {
3251                         close $fd
3252                         unlock_index
3253                         rescan [list set ui_status_value {Ready.}]
3254                 }
3255         }
3256         .mbar add cascade -label Tools -menu .mbar.tools
3257         menu .mbar.tools
3258         .mbar.tools add command -label "Migrate" \
3259                 -command do_miga \
3260                 -font font_ui
3261         lappend disable_on_lock \
3262                 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3263         }
3264
3265         # -- Help Menu
3266         #
3267         .mbar add cascade -label Help -menu .mbar.help
3268         menu .mbar.help
3269
3270         .mbar.help add command -label "About [appname]" \
3271                 -command do_about \
3272                 -font font_ui
3273 }
3274
3275
3276 # -- Branch Control
3277 #
3278 frame .branch \
3279         -borderwidth 1 \
3280         -relief sunken
3281 label .branch.l1 \
3282         -text {Current Branch:} \
3283         -anchor w \
3284         -justify left \
3285         -font font_ui
3286 label .branch.cb \
3287         -textvariable current_branch \
3288         -anchor w \
3289         -justify left \
3290         -font font_ui
3291 pack .branch.l1 -side left
3292 pack .branch.cb -side left -fill x
3293 pack .branch -side top -fill x
3294
3295 # -- Main Window Layout
3296 #
3297 panedwindow .vpane -orient vertical
3298 panedwindow .vpane.files -orient horizontal
3299 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3300 pack .vpane -anchor n -side top -fill both -expand 1
3301
3302 # -- Index File List
3303 #
3304 frame .vpane.files.index -height 100 -width 400
3305 label .vpane.files.index.title -text {Modified Files} \
3306         -background green \
3307         -font font_ui
3308 text $ui_index -background white -borderwidth 0 \
3309         -width 40 -height 10 \
3310         -font font_ui \
3311         -cursor $cursor_ptr \
3312         -yscrollcommand {.vpane.files.index.sb set} \
3313         -state disabled
3314 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3315 pack .vpane.files.index.title -side top -fill x
3316 pack .vpane.files.index.sb -side right -fill y
3317 pack $ui_index -side left -fill both -expand 1
3318 .vpane.files add .vpane.files.index -sticky nsew
3319
3320 # -- Working Directory File List
3321 #
3322 frame .vpane.files.workdir -height 100 -width 100
3323 label .vpane.files.workdir.title -text {Untracked Files} \
3324         -background red \
3325         -font font_ui
3326 text $ui_workdir -background white -borderwidth 0 \
3327         -width 40 -height 10 \
3328         -font font_ui \
3329         -cursor $cursor_ptr \
3330         -yscrollcommand {.vpane.files.workdir.sb set} \
3331         -state disabled
3332 scrollbar .vpane.files.workdir.sb -command [list $ui_workdir yview]
3333 pack .vpane.files.workdir.title -side top -fill x
3334 pack .vpane.files.workdir.sb -side right -fill y
3335 pack $ui_workdir -side left -fill both -expand 1
3336 .vpane.files add .vpane.files.workdir -sticky nsew
3337
3338 foreach i [list $ui_index $ui_workdir] {
3339         $i tag conf in_diff -font font_uibold
3340         $i tag conf in_sel \
3341                 -background [$i cget -foreground] \
3342                 -foreground [$i cget -background]
3343 }
3344 unset i
3345
3346 # -- Diff and Commit Area
3347 #
3348 frame .vpane.lower -height 300 -width 400
3349 frame .vpane.lower.commarea
3350 frame .vpane.lower.diff -relief sunken -borderwidth 1
3351 pack .vpane.lower.commarea -side top -fill x
3352 pack .vpane.lower.diff -side bottom -fill both -expand 1
3353 .vpane add .vpane.lower -stick nsew
3354
3355 # -- Commit Area Buttons
3356 #
3357 frame .vpane.lower.commarea.buttons
3358 label .vpane.lower.commarea.buttons.l -text {} \
3359         -anchor w \
3360         -justify left \
3361         -font font_ui
3362 pack .vpane.lower.commarea.buttons.l -side top -fill x
3363 pack .vpane.lower.commarea.buttons -side left -fill y
3364
3365 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3366         -command do_rescan \
3367         -font font_ui
3368 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3369 lappend disable_on_lock \
3370         {.vpane.lower.commarea.buttons.rescan conf -state}
3371
3372 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3373         -command do_include_all \
3374         -font font_ui
3375 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3376 lappend disable_on_lock \
3377         {.vpane.lower.commarea.buttons.incall conf -state}
3378
3379 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3380         -command do_signoff \
3381         -font font_ui
3382 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3383
3384 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3385         -command do_commit \
3386         -font font_ui
3387 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3388 lappend disable_on_lock \
3389         {.vpane.lower.commarea.buttons.commit conf -state}
3390
3391 # -- Commit Message Buffer
3392 #
3393 frame .vpane.lower.commarea.buffer
3394 frame .vpane.lower.commarea.buffer.header
3395 set ui_comm .vpane.lower.commarea.buffer.t
3396 set ui_coml .vpane.lower.commarea.buffer.header.l
3397 radiobutton .vpane.lower.commarea.buffer.header.new \
3398         -text {New Commit} \
3399         -command do_select_commit_type \
3400         -variable selected_commit_type \
3401         -value new \
3402         -font font_ui
3403 lappend disable_on_lock \
3404         [list .vpane.lower.commarea.buffer.header.new conf -state]
3405 radiobutton .vpane.lower.commarea.buffer.header.amend \
3406         -text {Amend Last Commit} \
3407         -command do_select_commit_type \
3408         -variable selected_commit_type \
3409         -value amend \
3410         -font font_ui
3411 lappend disable_on_lock \
3412         [list .vpane.lower.commarea.buffer.header.amend conf -state]
3413 label $ui_coml \
3414         -anchor w \
3415         -justify left \
3416         -font font_ui
3417 proc trace_commit_type {varname args} {
3418         global ui_coml commit_type
3419         switch -glob -- $commit_type {
3420         initial       {set txt {Initial Commit Message:}}
3421         amend         {set txt {Amended Commit Message:}}
3422         amend-initial {set txt {Amended Initial Commit Message:}}
3423         amend-merge   {set txt {Amended Merge Commit Message:}}
3424         merge         {set txt {Merge Commit Message:}}
3425         *             {set txt {Commit Message:}}
3426         }
3427         $ui_coml conf -text $txt
3428 }
3429 trace add variable commit_type write trace_commit_type
3430 pack $ui_coml -side left -fill x
3431 pack .vpane.lower.commarea.buffer.header.amend -side right
3432 pack .vpane.lower.commarea.buffer.header.new -side right
3433
3434 text $ui_comm -background white -borderwidth 1 \
3435         -undo true \
3436         -maxundo 20 \
3437         -autoseparators true \
3438         -relief sunken \
3439         -width 75 -height 9 -wrap none \
3440         -font font_diff \
3441         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3442 scrollbar .vpane.lower.commarea.buffer.sby \
3443         -command [list $ui_comm yview]
3444 pack .vpane.lower.commarea.buffer.header -side top -fill x
3445 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3446 pack $ui_comm -side left -fill y
3447 pack .vpane.lower.commarea.buffer -side left -fill y
3448
3449 # -- Commit Message Buffer Context Menu
3450 #
3451 set ctxm .vpane.lower.commarea.buffer.ctxm
3452 menu $ctxm -tearoff 0
3453 $ctxm add command \
3454         -label {Cut} \
3455         -font font_ui \
3456         -command {tk_textCut $ui_comm}
3457 $ctxm add command \
3458         -label {Copy} \
3459         -font font_ui \
3460         -command {tk_textCopy $ui_comm}
3461 $ctxm add command \
3462         -label {Paste} \
3463         -font font_ui \
3464         -command {tk_textPaste $ui_comm}
3465 $ctxm add command \
3466         -label {Delete} \
3467         -font font_ui \
3468         -command {$ui_comm delete sel.first sel.last}
3469 $ctxm add separator
3470 $ctxm add command \
3471         -label {Select All} \
3472         -font font_ui \
3473         -command {$ui_comm tag add sel 0.0 end}
3474 $ctxm add command \
3475         -label {Copy All} \
3476         -font font_ui \
3477         -command {
3478                 $ui_comm tag add sel 0.0 end
3479                 tk_textCopy $ui_comm
3480                 $ui_comm tag remove sel 0.0 end
3481         }
3482 $ctxm add separator
3483 $ctxm add command \
3484         -label {Sign Off} \
3485         -font font_ui \
3486         -command do_signoff
3487 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
3488
3489 # -- Diff Header
3490 #
3491 set current_diff {}
3492 set diff_actions [list]
3493 proc trace_current_diff {varname args} {
3494         global current_diff diff_actions file_states
3495         if {$current_diff eq {}} {
3496                 set s {}
3497                 set f {}
3498                 set p {}
3499                 set o disabled
3500         } else {
3501                 set p $current_diff
3502                 set s [mapdesc [lindex $file_states($p) 0] $p]
3503                 set f {File:}
3504                 set p [escape_path $p]
3505                 set o normal
3506         }
3507
3508         .vpane.lower.diff.header.status configure -text $s
3509         .vpane.lower.diff.header.file configure -text $f
3510         .vpane.lower.diff.header.path configure -text $p
3511         foreach w $diff_actions {
3512                 uplevel #0 $w $o
3513         }
3514 }
3515 trace add variable current_diff write trace_current_diff
3516
3517 frame .vpane.lower.diff.header -background orange
3518 label .vpane.lower.diff.header.status \
3519         -background orange \
3520         -width $max_status_desc \
3521         -anchor w \
3522         -justify left \
3523         -font font_ui
3524 label .vpane.lower.diff.header.file \
3525         -background orange \
3526         -anchor w \
3527         -justify left \
3528         -font font_ui
3529 label .vpane.lower.diff.header.path \
3530         -background orange \
3531         -anchor w \
3532         -justify left \
3533         -font font_ui
3534 pack .vpane.lower.diff.header.status -side left
3535 pack .vpane.lower.diff.header.file -side left
3536 pack .vpane.lower.diff.header.path -fill x
3537 set ctxm .vpane.lower.diff.header.ctxm
3538 menu $ctxm -tearoff 0
3539 $ctxm add command \
3540         -label {Copy} \
3541         -font font_ui \
3542         -command {
3543                 clipboard clear
3544                 clipboard append \
3545                         -format STRING \
3546                         -type STRING \
3547                         -- $current_diff
3548         }
3549 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3550 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
3551
3552 # -- Diff Body
3553 #
3554 frame .vpane.lower.diff.body
3555 set ui_diff .vpane.lower.diff.body.t
3556 text $ui_diff -background white -borderwidth 0 \
3557         -width 80 -height 15 -wrap none \
3558         -font font_diff \
3559         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3560         -yscrollcommand {.vpane.lower.diff.body.sby set} \
3561         -state disabled
3562 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3563         -command [list $ui_diff xview]
3564 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3565         -command [list $ui_diff yview]
3566 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3567 pack .vpane.lower.diff.body.sby -side right -fill y
3568 pack $ui_diff -side left -fill both -expand 1
3569 pack .vpane.lower.diff.header -side top -fill x
3570 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3571
3572 $ui_diff tag conf d_@ -font font_diffbold
3573 $ui_diff tag conf d_+  -foreground blue
3574 $ui_diff tag conf d_-  -foreground red
3575 $ui_diff tag conf d_++ -foreground {#00a000}
3576 $ui_diff tag conf d_-- -foreground {#a000a0}
3577 $ui_diff tag conf d_+- \
3578         -foreground red \
3579         -background {light goldenrod yellow}
3580 $ui_diff tag conf d_-+ \
3581         -foreground blue \
3582         -background azure2
3583
3584 # -- Diff Body Context Menu
3585 #
3586 set ctxm .vpane.lower.diff.body.ctxm
3587 menu $ctxm -tearoff 0
3588 $ctxm add command \
3589         -label {Copy} \
3590         -font font_ui \
3591         -command {tk_textCopy $ui_diff}
3592 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3593 $ctxm add command \
3594         -label {Select All} \
3595         -font font_ui \
3596         -command {$ui_diff tag add sel 0.0 end}
3597 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3598 $ctxm add command \
3599         -label {Copy All} \
3600         -font font_ui \
3601         -command {
3602                 $ui_diff tag add sel 0.0 end
3603                 tk_textCopy $ui_diff
3604                 $ui_diff tag remove sel 0.0 end
3605         }
3606 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3607 $ctxm add separator
3608 $ctxm add command \
3609         -label {Decrease Font Size} \
3610         -font font_ui \
3611         -command {incr_font_size font_diff -1}
3612 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3613 $ctxm add command \
3614         -label {Increase Font Size} \
3615         -font font_ui \
3616         -command {incr_font_size font_diff 1}
3617 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3618 $ctxm add separator
3619 $ctxm add command \
3620         -label {Show Less Context} \
3621         -font font_ui \
3622         -command {if {$repo_config(gui.diffcontext) >= 2} {
3623                 incr repo_config(gui.diffcontext) -1
3624                 reshow_diff
3625         }}
3626 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3627 $ctxm add command \
3628         -label {Show More Context} \
3629         -font font_ui \
3630         -command {
3631                 incr repo_config(gui.diffcontext)
3632                 reshow_diff
3633         }
3634 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3635 $ctxm add separator
3636 $ctxm add command -label {Options...} \
3637         -font font_ui \
3638         -command do_options
3639 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
3640
3641 # -- Status Bar
3642 #
3643 set ui_status_value {Initializing...}
3644 label .status -textvariable ui_status_value \
3645         -anchor w \
3646         -justify left \
3647         -borderwidth 1 \
3648         -relief sunken \
3649         -font font_ui
3650 pack .status -anchor w -side bottom -fill x
3651
3652 # -- Load geometry
3653 #
3654 catch {
3655 set gm $repo_config(gui.geometry)
3656 wm geometry . [lindex $gm 0]
3657 .vpane sash place 0 \
3658         [lindex [.vpane sash coord 0] 0] \
3659         [lindex $gm 1]
3660 .vpane.files sash place 0 \
3661         [lindex $gm 2] \
3662         [lindex [.vpane.files sash coord 0] 1]
3663 unset gm
3664 }
3665
3666 # -- Key Bindings
3667 #
3668 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3669 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3670 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3671 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3672 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3673 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3674 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3675 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3676 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3677 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3678 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3679
3680 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3681 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3682 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3683 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3684 bind $ui_diff <$M1B-Key-v> {break}
3685 bind $ui_diff <$M1B-Key-V> {break}
3686 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3687 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3688 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
3689 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
3690 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
3691 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
3692
3693 bind .   <Destroy> do_quit
3694 bind all <Key-F5> do_rescan
3695 bind all <$M1B-Key-r> do_rescan
3696 bind all <$M1B-Key-R> do_rescan
3697 bind .   <$M1B-Key-s> do_signoff
3698 bind .   <$M1B-Key-S> do_signoff
3699 bind .   <$M1B-Key-i> do_include_all
3700 bind .   <$M1B-Key-I> do_include_all
3701 bind .   <$M1B-Key-Return> do_commit
3702 bind all <$M1B-Key-q> do_quit
3703 bind all <$M1B-Key-Q> do_quit
3704 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3705 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3706 foreach i [list $ui_index $ui_workdir] {
3707         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
3708         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
3709         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
3710 }
3711 unset i
3712
3713 set file_lists($ui_index) [list]
3714 set file_lists($ui_workdir) [list]
3715
3716 set HEAD {}
3717 set PARENT {}
3718 set MERGE_HEAD [list]
3719 set commit_type {}
3720 set empty_tree {}
3721 set current_branch {}
3722 set current_diff {}
3723 set selected_commit_type new
3724
3725 wm title . "[appname] ([file normalize [file dirname [gitdir]]])"
3726 focus -force $ui_comm
3727
3728 # -- Warn the user about environmental problems.  Cygwin's Tcl
3729 #    does *not* pass its env array onto any processes it spawns.
3730 #    This means that git processes get none of our environment.
3731 #
3732 if {[is_Windows]} {
3733         set ignored_env 0
3734         set suggest_user {}
3735         set msg "Possible environment issues exist.
3736
3737 The following environment variables are probably
3738 going to be ignored by any Git subprocess run
3739 by [appname]:
3740
3741 "
3742         foreach name [array names env] {
3743                 switch -regexp -- $name {
3744                 {^GIT_INDEX_FILE$} -
3745                 {^GIT_OBJECT_DIRECTORY$} -
3746                 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3747                 {^GIT_DIFF_OPTS$} -
3748                 {^GIT_EXTERNAL_DIFF$} -
3749                 {^GIT_PAGER$} -
3750                 {^GIT_TRACE$} -
3751                 {^GIT_CONFIG$} -
3752                 {^GIT_CONFIG_LOCAL$} -
3753                 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3754                         append msg " - $name\n"
3755                         incr ignored_env
3756                 }
3757                 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3758                         append msg " - $name\n"
3759                         incr ignored_env
3760                         set suggest_user $name
3761                 }
3762                 }
3763         }
3764         if {$ignored_env > 0} {
3765                 append msg "
3766 This is due to a known issue with the
3767 Tcl binary distributed by Cygwin."
3768
3769                 if {$suggest_user ne {}} {
3770                         append msg "
3771
3772 A good replacement for $suggest_user
3773 is placing values for the user.name and
3774 user.email settings into your personal
3775 ~/.gitconfig file.
3776 "
3777                 }
3778                 warn_popup $msg
3779         }
3780         unset ignored_env msg suggest_user name
3781 }
3782
3783 # -- Only initialize complex UI if we are going to stay running.
3784 #
3785 if {!$single_commit} {
3786         load_all_remotes
3787         load_all_heads
3788
3789         populate_branch_menu .mbar.branch
3790         populate_fetch_menu .mbar.fetch
3791         populate_pull_menu .mbar.pull
3792         populate_push_menu .mbar.push
3793 }
3794
3795 # -- Only suggest a gc run if we are going to stay running.
3796 #
3797 if {!$single_commit} {
3798         set object_limit 2000
3799         if {[is_Windows]} {set object_limit 200}
3800         regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3801         if {$objects_current >= $object_limit} {
3802                 if {[ask_popup \
3803                         "This repository currently has $objects_current loose objects.
3804
3805 To maintain optimal performance it is strongly
3806 recommended that you compress the database
3807 when more than $object_limit loose objects exist.
3808
3809 Compress the database now?"] eq yes} {
3810                         do_gc
3811                 }
3812         }
3813         unset object_limit _junk objects_current
3814 }
3815
3816 lock_index begin-read
3817 after 1 do_rescan