git-gui

   1 #!/bin/sh
   2 # Tcl ignores the next line -*- tcl -*- \
   3 exec wish "$0" -- "$@"
   4
   5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras.  All rights reserved.
   6 # This program is free software; it may be used, copied, modified
   7 # and distributed under the terms of the GNU General Public Licence,
   8 # either version 2, or (at your option) any later version.
   9
  10 set appname [lindex [file split $argv0] end]
  11 set gitdir {}
  12
  13 ######################################################################
  14 ##
  15 ## config
  16
  17 proc is_many_config {name} {
  18         switch -glob -- $name {
  19         remote.*.fetch -
  20         remote.*.push
  21                 {return 1}
  22         *
  23                 {return 0}
  24         }
  25 }
  26
  27 proc load_config {include_global} {
  28         global repo_config global_config default_config
  29
  30         array unset global_config
  31         if {$include_global} {
  32                 catch {
  33                         set fd_rc [open "| git repo-config --global --list" r]
  34                         while {[gets $fd_rc line] >= 0} {
  35                                 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  36                                         if {[is_many_config $name]} {
  37                                                 lappend global_config($name) $value
  38                                         } else {
  39                                                 set global_config($name) $value
  40                                         }
  41                                 }
  42                         }
  43                         close $fd_rc
  44                 }
  45         }
  46
  47         array unset repo_config
  48         catch {
  49                 set fd_rc [open "| git repo-config --list" r]
  50                 while {[gets $fd_rc line] >= 0} {
  51                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
  52                                 if {[is_many_config $name]} {
  53                                         lappend repo_config($name) $value
  54                                 } else {
  55                                         set repo_config($name) $value
  56                                 }
  57                         }
  58                 }
  59                 close $fd_rc
  60         }
  61
  62         foreach name [array names default_config] {
  63                 if {[catch {set v $global_config($name)}]} {
  64                         set global_config($name) $default_config($name)
  65                 }
  66                 if {[catch {set v $repo_config($name)}]} {
  67                         set repo_config($name) $default_config($name)
  68                 }
  69         }
  70 }
  71
  72 proc save_config {} {
  73         global default_config font_descs
  74         global repo_config global_config
  75         global repo_config_new global_config_new
  76
  77         foreach option $font_descs {
  78                 set name [lindex $option 0]
  79                 set font [lindex $option 1]
  80                 font configure $font \
  81                         -family $global_config_new(gui.$font^^family) \
  82                         -size $global_config_new(gui.$font^^size)
  83                 font configure ${font}bold \
  84                         -family $global_config_new(gui.$font^^family) \
  85                         -size $global_config_new(gui.$font^^size)
  86                 set global_config_new(gui.$name) [font configure $font]
  87                 unset global_config_new(gui.$font^^family)
  88                 unset global_config_new(gui.$font^^size)
  89         }
  90
  91         foreach name [array names default_config] {
  92                 set value $global_config_new($name)
  93                 if {$value ne $global_config($name)} {
  94                         if {$value eq $default_config($name)} {
  95                                 catch {exec git repo-config --global --unset $name}
  96                         } else {
  97                                 regsub -all "\[{}\]" $value {"} value
  98                                 exec git repo-config --global $name $value
  99                         }
 100                         set global_config($name) $value
 101                         if {$value eq $repo_config($name)} {
 102                                 catch {exec git repo-config --unset $name}
 103                                 set repo_config($name) $value
 104                         }
 105                 }
 106         }
 107
 108         foreach name [array names default_config] {
 109                 set value $repo_config_new($name)
 110                 if {$value ne $repo_config($name)} {
 111                         if {$value eq $global_config($name)} {
 112                                 catch {exec git repo-config --unset $name}
 113                         } else {
 114                                 regsub -all "\[{}\]" $value {"} value
 115                                 exec git repo-config $name $value
 116                         }
 117                         set repo_config($name) $value
 118                 }
 119         }
 120 }
 121
 122 proc error_popup {msg} {
 123         global gitdir appname
 124
 125         set title $appname
 126         if {$gitdir ne {}} {
 127                 append title { (}
 128                 append title [lindex \
 129                         [file split [file normalize [file dirname $gitdir]]] \
 130                         end]
 131                 append title {)}
 132         }
 133         set cmd [list tk_messageBox \
 134                 -icon error \
 135                 -type ok \
 136                 -title "$title: error" \
 137                 -message $msg]
 138         if {[winfo ismapped .]} {
 139                 lappend cmd -parent .
 140         }
 141         eval $cmd
 142 }
 143
 144 proc info_popup {msg} {
 145         global gitdir appname
 146
 147         set title $appname
 148         if {$gitdir ne {}} {
 149                 append title { (}
 150                 append title [lindex \
 151                         [file split [file normalize [file dirname $gitdir]]] \
 152                         end]
 153                 append title {)}
 154         }
 155         tk_messageBox \
 156                 -parent . \
 157                 -icon error \
 158                 -type ok \
 159                 -title $title \
 160                 -message $msg
 161 }
 162
 163 ######################################################################
 164 ##
 165 ## repository setup
 166
 167 if {   [catch {set gitdir $env(GIT_DIR)}]
 168         && [catch {set gitdir [exec git rev-parse --git-dir]} err]} {
 169         catch {wm withdraw .}
 170         error_popup "Cannot find the git directory:\n\n$err"
 171         exit 1
 172 }
 173 if {![file isdirectory $gitdir]} {
 174         catch {wm withdraw .}
 175         error_popup "Git directory not found:\n\n$gitdir"
 176         exit 1
 177 }
 178 if {[lindex [file split $gitdir] end] ne {.git}} {
 179         catch {wm withdraw .}
 180         error_popup "Cannot use funny .git directory:\n\n$gitdir"
 181         exit 1
 182 }
 183 if {[catch {cd [file dirname $gitdir]} err]} {
 184         catch {wm withdraw .}
 185         error_popup "No working directory [file dirname $gitdir]:\n\n$err"
 186         exit 1
 187 }
 188
 189 set single_commit 0
 190 if {$appname eq {git-citool}} {
 191         set single_commit 1
 192 }
 193
 194 ######################################################################
 195 ##
 196 ## task management
 197
 198 set rescan_active 0
 199 set diff_active 0
 200 set last_clicked {}
 201
 202 set disable_on_lock [list]
 203 set index_lock_type none
 204
 205 set HEAD {}
 206 set PARENT {}
 207 set commit_type {}
 208 set empty_tree {}
 209
 210 proc lock_index {type} {
 211         global index_lock_type disable_on_lock
 212
 213         if {$index_lock_type eq {none}} {
 214                 set index_lock_type $type
 215                 foreach w $disable_on_lock {
 216                         uplevel #0 $w disabled
 217                 }
 218                 return 1
 219         } elseif {$index_lock_type eq {begin-update} && $type eq {update}} {
 220                 set index_lock_type $type
 221                 return 1
 222         }
 223         return 0
 224 }
 225
 226 proc unlock_index {} {
 227         global index_lock_type disable_on_lock
 228
 229         set index_lock_type none
 230         foreach w $disable_on_lock {
 231                 uplevel #0 $w normal
 232         }
 233 }
 234
 235 ######################################################################
 236 ##
 237 ## status
 238
 239 proc repository_state {hdvar ctvar} {
 240         global gitdir
 241         upvar $hdvar hd $ctvar ct
 242
 243         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
 244                 set hd {}
 245                 set ct initial
 246         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
 247                 set ct merge
 248         } else {
 249                 set ct normal
 250         }
 251 }
 252
 253 proc PARENT {} {
 254         global PARENT empty_tree
 255
 256         if {$PARENT ne {}} {
 257                 return $PARENT
 258         }
 259         if {$empty_tree eq {}} {
 260                 set empty_tree [exec git mktree << {}]
 261         }
 262         return $empty_tree
 263 }
 264
 265 proc rescan {after} {
 266         global HEAD PARENT commit_type
 267         global ui_index ui_other ui_status_value ui_comm
 268         global rescan_active file_states
 269         global repo_config
 270
 271         if {$rescan_active > 0 || ![lock_index read]} return
 272
 273         repository_state new_HEAD new_type
 274         if {[string match amend* $commit_type]
 275                 && $new_type eq {normal}
 276                 && $new_HEAD eq $HEAD} {
 277         } else {
 278                 set HEAD $new_HEAD
 279                 set PARENT $new_HEAD
 280                 set commit_type $new_type
 281         }
 282
 283         array unset file_states
 284
 285         if {![$ui_comm edit modified]
 286                 || [string trim [$ui_comm get 0.0 end]] eq {}} {
 287                 if {[load_message GITGUI_MSG]} {
 288                 } elseif {[load_message MERGE_MSG]} {
 289                 } elseif {[load_message SQUASH_MSG]} {
 290                 }
 291                 $ui_comm edit modified false
 292                 $ui_comm edit reset
 293         }
 294
 295         if {$repo_config(gui.trustmtime) eq {true}} {
 296                 rescan_stage2 {} $after
 297         } else {
 298                 set rescan_active 1
 299                 set ui_status_value {Refreshing file status...}
 300                 set cmd [list git update-index]
 301                 lappend cmd -q
 302                 lappend cmd --unmerged
 303                 lappend cmd --ignore-missing
 304                 lappend cmd --refresh
 305                 set fd_rf [open "| $cmd" r]
 306                 fconfigure $fd_rf -blocking 0 -translation binary
 307                 fileevent $fd_rf readable \
 308                         [list rescan_stage2 $fd_rf $after]
 309         }
 310 }
 311
 312 proc rescan_stage2 {fd after} {
 313         global gitdir ui_status_value
 314         global rescan_active buf_rdi buf_rdf buf_rlo
 315
 316         if {$fd ne {}} {
 317                 read $fd
 318                 if {![eof $fd]} return
 319                 close $fd
 320         }
 321
 322         set ls_others [list | git ls-files --others -z \
 323                 --exclude-per-directory=.gitignore]
 324         set info_exclude [file join $gitdir info exclude]
 325         if {[file readable $info_exclude]} {
 326                 lappend ls_others "--exclude-from=$info_exclude"
 327         }
 328
 329         set buf_rdi {}
 330         set buf_rdf {}
 331         set buf_rlo {}
 332
 333         set rescan_active 3
 334         set ui_status_value {Scanning for modified files ...}
 335         set fd_di [open "| git diff-index --cached -z [PARENT]" r]
 336         set fd_df [open "| git diff-files -z" r]
 337         set fd_lo [open $ls_others r]
 338
 339         fconfigure $fd_di -blocking 0 -translation binary
 340         fconfigure $fd_df -blocking 0 -translation binary
 341         fconfigure $fd_lo -blocking 0 -translation binary
 342         fileevent $fd_di readable [list read_diff_index $fd_di $after]
 343         fileevent $fd_df readable [list read_diff_files $fd_df $after]
 344         fileevent $fd_lo readable [list read_ls_others $fd_lo $after]
 345 }
 346
 347 proc load_message {file} {
 348         global gitdir ui_comm
 349
 350         set f [file join $gitdir $file]
 351         if {[file isfile $f]} {
 352                 if {[catch {set fd [open $f r]}]} {
 353                         return 0
 354                 }
 355                 set content [string trim [read $fd]]
 356                 close $fd
 357                 $ui_comm delete 0.0 end
 358                 $ui_comm insert end $content
 359                 return 1
 360         }
 361         return 0
 362 }
 363
 364 proc read_diff_index {fd after} {
 365         global buf_rdi
 366
 367         append buf_rdi [read $fd]
 368         set c 0
 369         set n [string length $buf_rdi]
 370         while {$c < $n} {
 371                 set z1 [string first "\0" $buf_rdi $c]
 372                 if {$z1 == -1} break
 373                 incr z1
 374                 set z2 [string first "\0" $buf_rdi $z1]
 375                 if {$z2 == -1} break
 376
 377                 set c $z2
 378                 incr z2 -1
 379                 display_file \
 380                         [string range $buf_rdi $z1 $z2] \
 381                         [string index $buf_rdi [expr {$z1 - 2}]]?
 382                 incr c
 383         }
 384         if {$c < $n} {
 385                 set buf_rdi [string range $buf_rdi $c end]
 386         } else {
 387                 set buf_rdi {}
 388         }
 389
 390         rescan_done $fd buf_rdi $after
 391 }
 392
 393 proc read_diff_files {fd after} {
 394         global buf_rdf
 395
 396         append buf_rdf [read $fd]
 397         set c 0
 398         set n [string length $buf_rdf]
 399         while {$c < $n} {
 400                 set z1 [string first "\0" $buf_rdf $c]
 401                 if {$z1 == -1} break
 402                 incr z1
 403                 set z2 [string first "\0" $buf_rdf $z1]
 404                 if {$z2 == -1} break
 405
 406                 set c $z2
 407                 incr z2 -1
 408                 display_file \
 409                         [string range $buf_rdf $z1 $z2] \
 410                         ?[string index $buf_rdf [expr {$z1 - 2}]]
 411                 incr c
 412         }
 413         if {$c < $n} {
 414                 set buf_rdf [string range $buf_rdf $c end]
 415         } else {
 416                 set buf_rdf {}
 417         }
 418
 419         rescan_done $fd buf_rdf $after
 420 }
 421
 422 proc read_ls_others {fd after} {
 423         global buf_rlo
 424
 425         append buf_rlo [read $fd]
 426         set pck [split $buf_rlo "\0"]
 427         set buf_rlo [lindex $pck end]
 428         foreach p [lrange $pck 0 end-1] {
 429                 display_file $p ?O
 430         }
 431         rescan_done $fd buf_rlo $after
 432 }
 433
 434 proc rescan_done {fd buf after} {
 435         global rescan_active
 436         global file_states repo_config
 437         upvar $buf to_clear
 438
 439         if {![eof $fd]} return
 440         set to_clear {}
 441         close $fd
 442         if {[incr rescan_active -1] > 0} return
 443
 444         prune_selection
 445         unlock_index
 446         display_all_files
 447
 448         if {$repo_config(gui.partialinclude) ne {true}} {
 449                 set pathList [list]
 450                 foreach path [array names file_states] {
 451                         switch -- [lindex $file_states($path) 0] {
 452                         AM -
 453                         MM {lappend pathList $path}
 454                         }
 455                 }
 456                 if {$pathList ne {}} {
 457                         update_index \
 458                                 "Updating included files" \
 459                                 $pathList \
 460                                 [concat {reshow_diff;} $after]
 461                         return
 462                 }
 463         }
 464
 465         reshow_diff
 466         uplevel #0 $after
 467 }
 468
 469 proc prune_selection {} {
 470         global file_states selected_paths
 471
 472         foreach path [array names selected_paths] {
 473                 if {[catch {set still_here $file_states($path)}]} {
 474                         unset selected_paths($path)
 475                 }
 476         }
 477 }
 478
 479 ######################################################################
 480 ##
 481 ## diff
 482
 483 proc clear_diff {} {
 484         global ui_diff current_diff ui_index ui_other
 485
 486         $ui_diff conf -state normal
 487         $ui_diff delete 0.0 end
 488         $ui_diff conf -state disabled
 489
 490         set current_diff {}
 491
 492         $ui_index tag remove in_diff 0.0 end
 493         $ui_other tag remove in_diff 0.0 end
 494 }
 495
 496 proc reshow_diff {} {
 497         global current_diff ui_status_value file_states
 498
 499         if {$current_diff eq {}
 500                 || [catch {set s $file_states($current_diff)}]} {
 501                 clear_diff
 502         } else {
 503                 show_diff $current_diff
 504         }
 505 }
 506
 507 proc handle_empty_diff {} {
 508         global current_diff file_states file_lists
 509
 510         set path $current_diff
 511         set s $file_states($path)
 512         if {[lindex $s 0] ne {_M}} return
 513
 514         info_popup "No differences detected.
 515
 516 [short_path $path] has no changes.
 517
 518 The modification date of this file was updated
 519 by another application and you currently have
 520 the Trust File Modification Timestamps option
 521 enabled, so Git did not automatically detect
 522 that there are no content differences in this
 523 file.
 524
 525 This file will now be removed from the modified
 526 files list, to prevent possible confusion.
 527 "
 528         if {[catch {exec git update-index -- $path} err]} {
 529                 error_popup "Failed to refresh index:\n\n$err"
 530         }
 531
 532         clear_diff
 533         set old_w [mapcol [lindex $file_states($path) 0] $path]
 534         set lno [lsearch -sorted $file_lists($old_w) $path]
 535         if {$lno >= 0} {
 536                 set file_lists($old_w) \
 537                         [lreplace $file_lists($old_w) $lno $lno]
 538                 incr lno
 539                 $old_w conf -state normal
 540                 $old_w delete $lno.0 [expr {$lno + 1}].0
 541                 $old_w conf -state disabled
 542         }
 543 }
 544
 545 proc show_diff {path {w {}} {lno {}}} {
 546         global file_states file_lists
 547         global diff_3way diff_active repo_config
 548         global ui_diff current_diff ui_status_value
 549
 550         if {$diff_active || ![lock_index read]} return
 551
 552         clear_diff
 553         if {$w eq {} || $lno == {}} {
 554                 foreach w [array names file_lists] {
 555                         set lno [lsearch -sorted $file_lists($w) $path]
 556                         if {$lno >= 0} {
 557                                 incr lno
 558                                 break
 559                         }
 560                 }
 561         }
 562         if {$w ne {} && $lno >= 1} {
 563                 $w tag add in_diff $lno.0 [expr {$lno + 1}].0
 564         }
 565
 566         set s $file_states($path)
 567         set m [lindex $s 0]
 568         set diff_3way 0
 569         set diff_active 1
 570         set current_diff $path
 571         set ui_status_value "Loading diff of [escape_path $path]..."
 572
 573         set cmd [list | git diff-index]
 574         lappend cmd --no-color
 575         if {$repo_config(gui.diffcontext) > 0} {
 576                 lappend cmd "-U$repo_config(gui.diffcontext)"
 577         }
 578         lappend cmd -p
 579
 580         switch $m {
 581         MM {
 582                 lappend cmd -c
 583         }
 584         _O {
 585                 if {[catch {
 586                                 set fd [open $path r]
 587                                 set content [read $fd]
 588                                 close $fd
 589                         } err ]} {
 590                         set diff_active 0
 591                         unlock_index
 592                         set ui_status_value "Unable to display [escape_path $path]"
 593                         error_popup "Error loading file:\n\n$err"
 594                         return
 595                 }
 596                 $ui_diff conf -state normal
 597                 $ui_diff insert end $content
 598                 $ui_diff conf -state disabled
 599                 set diff_active 0
 600                 unlock_index
 601                 set ui_status_value {Ready.}
 602                 return
 603         }
 604         }
 605
 606         lappend cmd [PARENT]
 607         lappend cmd --
 608         lappend cmd $path
 609
 610         if {[catch {set fd [open $cmd r]} err]} {
 611                 set diff_active 0
 612                 unlock_index
 613                 set ui_status_value "Unable to display [escape_path $path]"
 614                 error_popup "Error loading diff:\n\n$err"
 615                 return
 616         }
 617
 618         fconfigure $fd -blocking 0 -translation auto
 619         fileevent $fd readable [list read_diff $fd]
 620 }
 621
 622 proc read_diff {fd} {
 623         global ui_diff ui_status_value diff_3way diff_active
 624         global repo_config
 625
 626         while {[gets $fd line] >= 0} {
 627                 if {[string match {diff --git *} $line]} continue
 628                 if {[string match {diff --combined *} $line]} continue
 629                 if {[string match {--- *} $line]} continue
 630                 if {[string match {+++ *} $line]} continue
 631                 if {[string match index* $line]} {
 632                         if {[string first , $line] >= 0} {
 633                                 set diff_3way 1
 634                         }
 635                 }
 636
 637                 $ui_diff conf -state normal
 638                 if {!$diff_3way} {
 639                         set x [string index $line 0]
 640                         switch -- $x {
 641                         "@" {set tags da}
 642                         "+" {set tags dp}
 643                         "-" {set tags dm}
 644                         default {set tags {}}
 645                         }
 646                 } else {
 647                         set x [string range $line 0 1]
 648                         switch -- $x {
 649                         default {set tags {}}
 650                         "@@" {set tags da}
 651                         "++" {set tags dp; set x " +"}
 652                         " +" {set tags {di bold}; set x "++"}
 653                         "+ " {set tags dni; set x "-+"}
 654                         "--" {set tags dm; set x " -"}
 655                         " -" {set tags {dm bold}; set x "--"}
 656                         "- " {set tags di; set x "+-"}
 657                         default {set tags {}}
 658                         }
 659                         set line [string replace $line 0 1 $x]
 660                 }
 661                 $ui_diff insert end $line $tags
 662                 $ui_diff insert end "\n"
 663                 $ui_diff conf -state disabled
 664         }
 665
 666         if {[eof $fd]} {
 667                 close $fd
 668                 set diff_active 0
 669                 unlock_index
 670                 set ui_status_value {Ready.}
 671
 672                 if {$repo_config(gui.trustmtime) eq {true}
 673                         && [$ui_diff index end] eq {2.0}} {
 674                         handle_empty_diff
 675                 }
 676         }
 677 }
 678
 679 ######################################################################
 680 ##
 681 ## commit
 682
 683 proc load_last_commit {} {
 684         global HEAD PARENT commit_type ui_comm
 685
 686         if {[string match amend* $commit_type]} return
 687         if {$commit_type ne {normal}} {
 688                 error_popup "Can't amend a $commit_type commit."
 689                 return
 690         }
 691
 692         set msg {}
 693         set parent {}
 694         set parent_count 0
 695         if {[catch {
 696                         set fd [open "| git cat-file commit $HEAD" r]
 697                         while {[gets $fd line] > 0} {
 698                                 if {[string match {parent *} $line]} {
 699                                         set parent [string range $line 7 end]
 700                                         incr parent_count
 701                                 }
 702                         }
 703                         set msg [string trim [read $fd]]
 704                         close $fd
 705                 } err]} {
 706                 error_popup "Error loading commit data for amend:\n\n$err"
 707                 return
 708         }
 709
 710         if {$parent_count > 1} {
 711                 error_popup {Can't amend a merge commit.}
 712                 return
 713         }
 714
 715         if {$parent_count == 0} {
 716                 set commit_type amend-initial
 717                 set PARENT {}
 718         } elseif {$parent_count == 1} {
 719                 set commit_type amend
 720                 set PARENT $parent
 721         }
 722
 723         $ui_comm delete 0.0 end
 724         $ui_comm insert end $msg
 725         $ui_comm edit modified false
 726         $ui_comm edit reset
 727         rescan {set ui_status_value {Ready.}}
 728 }
 729
 730 proc commit_tree {} {
 731         global HEAD commit_type file_states ui_comm repo_config
 732
 733         if {![lock_index update]} return
 734
 735         # -- Our in memory state should match the repository.
 736         #
 737         repository_state curHEAD cur_type
 738         if {[string match amend* $commit_type]
 739                 && $cur_type eq {normal}
 740                 && $curHEAD eq $HEAD} {
 741         } elseif {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
 742                 error_popup {Last scanned state does not match repository state.
 743
 744 Its highly likely that another Git program modified the
 745 repository since the last scan.  A rescan is required
 746 before committing.
 747
 748 A rescan will be automatically started now.
 749 }
 750                 unlock_index
 751                 rescan {set ui_status_value {Ready.}}
 752                 return
 753         }
 754
 755         # -- At least one file should differ in the index.
 756         #
 757         set files_ready 0
 758         foreach path [array names file_states] {
 759                 switch -glob -- [lindex $file_states($path) 0] {
 760                 _? {continue}
 761                 A? -
 762                 D? -
 763                 M? {set files_ready 1; break}
 764                 U? {
 765                         error_popup "Unmerged files cannot be committed.
 766
 767 File [short_path $path] has merge conflicts.
 768 You must resolve them and include the file before committing.
 769 "
 770                         unlock_index
 771                         return
 772                 }
 773                 default {
 774                         error_popup "Unknown file state [lindex $s 0] detected.
 775
 776 File [short_path $path] cannot be committed by this program.
 777 "
 778                 }
 779                 }
 780         }
 781         if {!$files_ready} {
 782                 error_popup {No included files to commit.
 783
 784 You must include at least 1 file before you can commit.
 785 }
 786                 unlock_index
 787                 return
 788         }
 789
 790         # -- A message is required.
 791         #
 792         set msg [string trim [$ui_comm get 1.0 end]]
 793         if {$msg eq {}} {
 794                 error_popup {Please supply a commit message.
 795
 796 A good commit message has the following format:
 797
 798 - First line: Describe in one sentance what you did.
 799 - Second line: Blank
 800 - Remaining lines: Describe why this change is good.
 801 }
 802                 unlock_index
 803                 return
 804         }
 805
 806         # -- Update included files if partialincludes are off.
 807         #
 808         if {$repo_config(gui.partialinclude) ne {true}} {
 809                 set pathList [list]
 810                 foreach path [array names file_states] {
 811                         switch -glob -- [lindex $file_states($path) 0] {
 812                         A? -
 813                         M? {lappend pathList $path}
 814                         }
 815                 }
 816                 if {$pathList ne {}} {
 817                         unlock_index
 818                         update_index \
 819                                 "Updating included files" \
 820                                 $pathList \
 821                                 [concat {lock_index update;} \
 822                                         [list commit_prehook $curHEAD $msg]]
 823                         return
 824                 }
 825         }
 826
 827         commit_prehook $curHEAD $msg
 828 }
 829
 830 proc commit_prehook {curHEAD msg} {
 831         global tcl_platform gitdir ui_status_value pch_error
 832
 833         # On Cygwin [file executable] might lie so we need to ask
 834         # the shell if the hook is executable.  Yes that's annoying.
 835
 836         set pchook [file join $gitdir hooks pre-commit]
 837         if {$tcl_platform(platform) eq {windows}
 838                 && [file isfile $pchook]} {
 839                 set pchook [list sh -c [concat \
 840                         "if test -x \"$pchook\";" \
 841                         "then exec \"$pchook\" 2>&1;" \
 842                         "fi"]]
 843         } elseif {[file executable $pchook]} {
 844                 set pchook [list $pchook |& cat]
 845         } else {
 846                 commit_writetree $curHEAD $msg
 847                 return
 848         }
 849
 850         set ui_status_value {Calling pre-commit hook...}
 851         set pch_error {}
 852         set fd_ph [open "| $pchook" r]
 853         fconfigure $fd_ph -blocking 0 -translation binary
 854         fileevent $fd_ph readable \
 855                 [list commit_prehook_wait $fd_ph $curHEAD $msg]
 856 }
 857
 858 proc commit_prehook_wait {fd_ph curHEAD msg} {
 859         global pch_error ui_status_value
 860
 861         append pch_error [read $fd_ph]
 862         fconfigure $fd_ph -blocking 1
 863         if {[eof $fd_ph]} {
 864                 if {[catch {close $fd_ph}]} {
 865                         set ui_status_value {Commit declined by pre-commit hook.}
 866                         hook_failed_popup pre-commit $pch_error
 867                         unlock_index
 868                 } else {
 869                         commit_writetree $curHEAD $msg
 870                 }
 871                 set pch_error {}
 872                 return
 873         }
 874         fconfigure $fd_ph -blocking 0
 875 }
 876
 877 proc commit_writetree {curHEAD msg} {
 878         global ui_status_value
 879
 880         set ui_status_value {Committing changes...}
 881         set fd_wt [open "| git write-tree" r]
 882         fileevent $fd_wt readable \
 883                 [list commit_committree $fd_wt $curHEAD $msg]
 884 }
 885
 886 proc commit_committree {fd_wt curHEAD msg} {
 887         global single_commit gitdir HEAD PARENT commit_type tcl_platform
 888         global ui_status_value ui_comm
 889         global file_states selected_paths
 890
 891         gets $fd_wt tree_id
 892         if {$tree_id eq {} || [catch {close $fd_wt} err]} {
 893                 error_popup "write-tree failed:\n\n$err"
 894                 set ui_status_value {Commit failed.}
 895                 unlock_index
 896                 return
 897         }
 898
 899         # -- Create the commit.
 900         #
 901         set cmd [list git commit-tree $tree_id]
 902         if {$PARENT ne {}} {
 903                 lappend cmd -p $PARENT
 904         }
 905         if {$commit_type eq {merge}} {
 906                 if {[catch {
 907                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 908                                 while {[gets $fd_mh merge_head] >= 0} {
 909                                         lappend cmd -p $merge_head
 910                                 }
 911                                 close $fd_mh
 912                         } err]} {
 913                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
 914                         set ui_status_value {Commit failed.}
 915                         unlock_index
 916                         return
 917                 }
 918         }
 919         if {$PARENT eq {}} {
 920                 # git commit-tree writes to stderr during initial commit.
 921                 lappend cmd 2>/dev/null
 922         }
 923         lappend cmd << $msg
 924         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 925                 error_popup "commit-tree failed:\n\n$err"
 926                 set ui_status_value {Commit failed.}
 927                 unlock_index
 928                 return
 929         }
 930
 931         # -- Update the HEAD ref.
 932         #
 933         set reflogm commit
 934         if {$commit_type ne {normal}} {
 935                 append reflogm " ($commit_type)"
 936         }
 937         set i [string first "\n" $msg]
 938         if {$i >= 0} {
 939                 append reflogm {: } [string range $msg 0 [expr {$i - 1}]]
 940         } else {
 941                 append reflogm {: } $msg
 942         }
 943         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 944         if {[catch {eval exec $cmd} err]} {
 945                 error_popup "update-ref failed:\n\n$err"
 946                 set ui_status_value {Commit failed.}
 947                 unlock_index
 948                 return
 949         }
 950
 951         # -- Cleanup after ourselves.
 952         #
 953         catch {file delete [file join $gitdir MERGE_HEAD]}
 954         catch {file delete [file join $gitdir MERGE_MSG]}
 955         catch {file delete [file join $gitdir SQUASH_MSG]}
 956         catch {file delete [file join $gitdir GITGUI_MSG]}
 957
 958         # -- Let rerere do its thing.
 959         #
 960         if {[file isdirectory [file join $gitdir rr-cache]]} {
 961                 catch {exec git rerere}
 962         }
 963
 964         # -- Run the post-commit hook.
 965         #
 966         set pchook [file join $gitdir hooks post-commit]
 967         if {$tcl_platform(platform) eq {windows} && [file isfile $pchook]} {
 968                 set pchook [list sh -c [concat \
 969                         "if test -x \"$pchook\";" \
 970                         "then exec \"$pchook\";" \
 971                         "fi"]]
 972         } elseif {![file executable $pchook]} {
 973                 set pchook {}
 974         }
 975         if {$pchook ne {}} {
 976                 catch {exec $pchook &}
 977         }
 978
 979         $ui_comm delete 0.0 end
 980         $ui_comm edit modified false
 981         $ui_comm edit reset
 982
 983         if {$single_commit} do_quit
 984
 985         # -- Update status without invoking any git commands.
 986         #
 987         set commit_type normal
 988         set HEAD $cmt_id
 989         set PARENT $cmt_id
 990
 991         foreach path [array names file_states] {
 992                 set s $file_states($path)
 993                 set m [lindex $s 0]
 994                 switch -glob -- $m {
 995                 A? -
 996                 M? -
 997                 D? {set m _[string index $m 1]}
 998                 }
 999
1000                 if {$m eq {__}} {
1001                         unset file_states($path)
1002                         catch {unset selected_paths($path)}
1003                 } else {
1004                         lset file_states($path) 0 $m
1005                 }
1006         }
1007
1008         display_all_files
1009         unlock_index
1010         reshow_diff
1011         set ui_status_value \
1012                 "Changes committed as [string range $cmt_id 0 7]."
1013 }
1014
1015 ######################################################################
1016 ##
1017 ## fetch pull push
1018
1019 proc fetch_from {remote} {
1020         set w [new_console "fetch $remote" \
1021                 "Fetching new changes from $remote"]
1022         set cmd [list git fetch]
1023         lappend cmd $remote
1024         console_exec $w $cmd
1025 }
1026
1027 proc pull_remote {remote branch} {
1028         global HEAD commit_type file_states repo_config
1029
1030         if {![lock_index update]} return
1031
1032         # -- Our in memory state should match the repository.
1033         #
1034         repository_state curHEAD cur_type
1035         if {$commit_type ne $cur_type || $HEAD ne $curHEAD} {
1036                 error_popup {Last scanned state does not match repository state.
1037
1038 Its highly likely that another Git program modified the
1039 repository since our last scan.  A rescan is required
1040 before a pull can be started.
1041 }
1042                 unlock_index
1043                 rescan {set ui_status_value {Ready.}}
1044                 return
1045         }
1046
1047         # -- No differences should exist before a pull.
1048         #
1049         if {[array size file_states] != 0} {
1050                 error_popup {Uncommitted but modified files are present.
1051
1052 You should not perform a pull with unmodified files in your working
1053 directory as Git would be unable to recover from an incorrect merge.
1054
1055 Commit or throw away all changes before starting a pull operation.
1056 }
1057                 unlock_index
1058                 return
1059         }
1060
1061         set w [new_console "pull $remote $branch" \
1062                 "Pulling new changes from branch $branch in $remote"]
1063         set cmd [list git pull]
1064         if {$repo_config(gui.pullsummary) eq {false}} {
1065                 lappend cmd --no-summary
1066         }
1067         lappend cmd $remote
1068         lappend cmd $branch
1069         console_exec $w $cmd [list post_pull_remote $remote $branch]
1070 }
1071
1072 proc post_pull_remote {remote branch success} {
1073         global HEAD PARENT commit_type
1074         global ui_status_value
1075
1076         unlock_index
1077         if {$success} {
1078                 repository_state HEAD commit_type
1079                 set PARENT $HEAD
1080                 set $ui_status_value "Pulling $branch from $remote complete."
1081         } else {
1082                 set m "Conflicts detected while pulling $branch from $remote."
1083                 rescan "set ui_status_value {$m}"
1084         }
1085 }
1086
1087 proc push_to {remote} {
1088         set w [new_console "push $remote" \
1089                 "Pushing changes to $remote"]
1090         set cmd [list git push]
1091         lappend cmd $remote
1092         console_exec $w $cmd
1093 }
1094
1095 ######################################################################
1096 ##
1097 ## ui helpers
1098
1099 proc mapcol {state path} {
1100         global all_cols ui_other
1101
1102         if {[catch {set r $all_cols($state)}]} {
1103                 puts "error: no column for state={$state} $path"
1104                 return $ui_other
1105         }
1106         return $r
1107 }
1108
1109 proc mapicon {state path} {
1110         global all_icons
1111
1112         if {[catch {set r $all_icons($state)}]} {
1113                 puts "error: no icon for state={$state} $path"
1114                 return file_plain
1115         }
1116         return $r
1117 }
1118
1119 proc mapdesc {state path} {
1120         global all_descs
1121
1122         if {[catch {set r $all_descs($state)}]} {
1123                 puts "error: no desc for state={$state} $path"
1124                 return $state
1125         }
1126         return $r
1127 }
1128
1129 proc escape_path {path} {
1130         regsub -all "\n" $path "\\n" path
1131         return $path
1132 }
1133
1134 proc short_path {path} {
1135         return [escape_path [lindex [file split $path] end]]
1136 }
1137
1138 set next_icon_id 0
1139
1140 proc merge_state {path new_state} {
1141         global file_states next_icon_id
1142
1143         set s0 [string index $new_state 0]
1144         set s1 [string index $new_state 1]
1145
1146         if {[catch {set info $file_states($path)}]} {
1147                 set state __
1148                 set icon n[incr next_icon_id]
1149         } else {
1150                 set state [lindex $info 0]
1151                 set icon [lindex $info 1]
1152         }
1153
1154         if {$s0 eq {?}} {
1155                 set s0 [string index $state 0]
1156         } elseif {$s0 eq {_}} {
1157                 set s0 _
1158         }
1159
1160         if {$s1 eq {?}} {
1161                 set s1 [string index $state 1]
1162         } elseif {$s1 eq {_}} {
1163                 set s1 _
1164         }
1165
1166         set file_states($path) [list $s0$s1 $icon]
1167         return $state
1168 }
1169
1170 proc display_file {path state} {
1171         global file_states file_lists selected_paths rescan_active
1172
1173         set old_m [merge_state $path $state]
1174         if {$rescan_active > 0} return
1175
1176         set s $file_states($path)
1177         set new_m [lindex $s 0]
1178         set new_w [mapcol $new_m $path]
1179         set old_w [mapcol $old_m $path]
1180         set new_icon [mapicon $new_m $path]
1181
1182         if {$new_w ne $old_w} {
1183                 set lno [lsearch -sorted $file_lists($old_w) $path]
1184                 if {$lno >= 0} {
1185                         incr lno
1186                         $old_w conf -state normal
1187                         $old_w delete $lno.0 [expr {$lno + 1}].0
1188                         $old_w conf -state disabled
1189                 }
1190
1191                 lappend file_lists($new_w) $path
1192                 set file_lists($new_w) [lsort $file_lists($new_w)]
1193                 set lno [lsearch -sorted $file_lists($new_w) $path]
1194                 incr lno
1195                 $new_w conf -state normal
1196                 $new_w image create $lno.0 \
1197                         -align center -padx 5 -pady 1 \
1198                         -name [lindex $s 1] \
1199                         -image $new_icon
1200                 $new_w insert $lno.1 "[escape_path $path]\n"
1201                 if {[catch {set in_sel $selected_paths($path)}]} {
1202                         set in_sel 0
1203                 }
1204                 if {$in_sel} {
1205                         $new_w tag add in_sel $lno.0 [expr {$lno + 1}].0
1206                 }
1207                 $new_w conf -state disabled
1208         } elseif {$new_icon ne [mapicon $old_m $path]} {
1209                 $new_w conf -state normal
1210                 $new_w image conf [lindex $s 1] -image $new_icon
1211                 $new_w conf -state disabled
1212         }
1213 }
1214
1215 proc display_all_files {} {
1216         global ui_index ui_other
1217         global file_states file_lists
1218         global last_clicked selected_paths
1219
1220         $ui_index conf -state normal
1221         $ui_other conf -state normal
1222
1223         $ui_index delete 0.0 end
1224         $ui_other delete 0.0 end
1225         set last_clicked {}
1226
1227         set file_lists($ui_index) [list]
1228         set file_lists($ui_other) [list]
1229
1230         foreach path [lsort [array names file_states]] {
1231                 set s $file_states($path)
1232                 set m [lindex $s 0]
1233                 set w [mapcol $m $path]
1234                 lappend file_lists($w) $path
1235                 set lno [expr {[lindex [split [$w index end] .] 0] - 1}]
1236                 $w image create end \
1237                         -align center -padx 5 -pady 1 \
1238                         -name [lindex $s 1] \
1239                         -image [mapicon $m $path]
1240                 $w insert end "[escape_path $path]\n"
1241                 if {[catch {set in_sel $selected_paths($path)}]} {
1242                         set in_sel 0
1243                 }
1244                 if {$in_sel} {
1245                         $w tag add in_sel $lno.0 [expr {$lno + 1}].0
1246                 }
1247         }
1248
1249         $ui_index conf -state disabled
1250         $ui_other conf -state disabled
1251 }
1252
1253 proc update_index {msg pathList after} {
1254         global update_index_cp ui_status_value
1255
1256         if {![lock_index update]} return
1257
1258         set update_index_cp 0
1259         set pathList [lsort $pathList]
1260         set totalCnt [llength $pathList]
1261         set batch [expr {int($totalCnt * .01) + 1}]
1262         if {$batch > 25} {set batch 25}
1263
1264         set ui_status_value [format \
1265                 "$msg... %i/%i files (%.2f%%)" \
1266                 $update_index_cp \
1267                 $totalCnt \
1268                 0.0]
1269         set fd [open "| git update-index --add --remove -z --stdin" w]
1270         fconfigure $fd \
1271                 -blocking 0 \
1272                 -buffering full \
1273                 -buffersize 512 \
1274                 -translation binary
1275         fileevent $fd writable [list \
1276                 write_update_index \
1277                 $fd \
1278                 $pathList \
1279                 $totalCnt \
1280                 $batch \
1281                 $msg \
1282                 $after \
1283                 ]
1284 }
1285
1286 proc write_update_index {fd pathList totalCnt batch msg after} {
1287         global update_index_cp ui_status_value
1288         global file_states current_diff
1289
1290         if {$update_index_cp >= $totalCnt} {
1291                 close $fd
1292                 unlock_index
1293                 uplevel #0 $after
1294                 return
1295         }
1296
1297         for {set i $batch} \
1298                 {$update_index_cp < $totalCnt && $i > 0} \
1299                 {incr i -1} {
1300                 set path [lindex $pathList $update_index_cp]
1301                 incr update_index_cp
1302
1303                 switch -glob -- [lindex $file_states($path) 0] {
1304                 AD -
1305                 MD -
1306                 _D {set new D_}
1307
1308                 _M -
1309                 MM -
1310                 M_ {set new M_}
1311
1312                 _O -
1313                 AM -
1314                 A_ {set new A_}
1315
1316                 ?? {continue}
1317                 }
1318
1319                 puts -nonewline $fd $path
1320                 puts -nonewline $fd "\0"
1321                 display_file $path $new
1322         }
1323
1324         set ui_status_value [format \
1325                 "$msg... %i/%i files (%.2f%%)" \
1326                 $update_index_cp \
1327                 $totalCnt \
1328                 [expr {100.0 * $update_index_cp / $totalCnt}]]
1329 }
1330
1331 ######################################################################
1332 ##
1333 ## remote management
1334
1335 proc load_all_remotes {} {
1336         global gitdir all_remotes repo_config
1337
1338         set all_remotes [list]
1339         set rm_dir [file join $gitdir remotes]
1340         if {[file isdirectory $rm_dir]} {
1341                 set all_remotes [concat $all_remotes [glob \
1342                         -types f \
1343                         -tails \
1344                         -nocomplain \
1345                         -directory $rm_dir *]]
1346         }
1347
1348         foreach line [array names repo_config remote.*.url] {
1349                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1350                         lappend all_remotes $name
1351                 }
1352         }
1353
1354         set all_remotes [lsort -unique $all_remotes]
1355 }
1356
1357 proc populate_fetch_menu {m} {
1358         global gitdir all_remotes repo_config
1359
1360         foreach r $all_remotes {
1361                 set enable 0
1362                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1363                         if {![catch {set a $repo_config(remote.$r.fetch)}]} {
1364                                 set enable 1
1365                         }
1366                 } else {
1367                         catch {
1368                                 set fd [open [file join $gitdir remotes $r] r]
1369                                 while {[gets $fd n] >= 0} {
1370                                         if {[regexp {^Pull:[ \t]*([^:]+):} $n]} {
1371                                                 set enable 1
1372                                                 break
1373                                         }
1374                                 }
1375                                 close $fd
1376                         }
1377                 }
1378
1379                 if {$enable} {
1380                         $m add command \
1381                                 -label "Fetch from $r..." \
1382                                 -command [list fetch_from $r] \
1383                                 -font font_ui
1384                 }
1385         }
1386 }
1387
1388 proc populate_push_menu {m} {
1389         global gitdir all_remotes repo_config
1390
1391         foreach r $all_remotes {
1392                 set enable 0
1393                 if {![catch {set a $repo_config(remote.$r.url)}]} {
1394                         if {![catch {set a $repo_config(remote.$r.push)}]} {
1395                                 set enable 1
1396                         }
1397                 } else {
1398                         catch {
1399                                 set fd [open [file join $gitdir remotes $r] r]
1400                                 while {[gets $fd n] >= 0} {
1401                                         if {[regexp {^Push:[ \t]*([^:]+):} $n]} {
1402                                                 set enable 1
1403                                                 break
1404                                         }
1405                                 }
1406                                 close $fd
1407                         }
1408                 }
1409
1410                 if {$enable} {
1411                         $m add command \
1412                                 -label "Push to $r..." \
1413                                 -command [list push_to $r] \
1414                                 -font font_ui
1415                 }
1416         }
1417 }
1418
1419 proc populate_pull_menu {m} {
1420         global gitdir repo_config all_remotes disable_on_lock
1421
1422         foreach remote $all_remotes {
1423                 set rb {}
1424                 if {[array get repo_config remote.$remote.url] ne {}} {
1425                         if {[array get repo_config remote.$remote.fetch] ne {}} {
1426                                 regexp {^([^:]+):} \
1427                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1428                                         line rb
1429                         }
1430                 } else {
1431                         catch {
1432                                 set fd [open [file join $gitdir remotes $remote] r]
1433                                 while {[gets $fd line] >= 0} {
1434                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1435                                                 break
1436                                         }
1437                                 }
1438                                 close $fd
1439                         }
1440                 }
1441
1442                 set rb_short $rb
1443                 regsub ^refs/heads/ $rb {} rb_short
1444                 if {$rb_short ne {}} {
1445                         $m add command \
1446                                 -label "Branch $rb_short from $remote..." \
1447                                 -command [list pull_remote $remote $rb] \
1448                                 -font font_ui
1449                         lappend disable_on_lock \
1450                                 [list $m entryconf [$m index last] -state]
1451                 }
1452         }
1453 }
1454
1455 ######################################################################
1456 ##
1457 ## icons
1458
1459 set filemask {
1460 #define mask_width 14
1461 #define mask_height 15
1462 static unsigned char mask_bits[] = {
1463    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1464    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1465    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1466 }
1467
1468 image create bitmap file_plain -background white -foreground black -data {
1469 #define plain_width 14
1470 #define plain_height 15
1471 static unsigned char plain_bits[] = {
1472    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1473    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1474    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1475 } -maskdata $filemask
1476
1477 image create bitmap file_mod -background white -foreground blue -data {
1478 #define mod_width 14
1479 #define mod_height 15
1480 static unsigned char mod_bits[] = {
1481    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1482    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1483    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1484 } -maskdata $filemask
1485
1486 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1487 #define file_fulltick_width 14
1488 #define file_fulltick_height 15
1489 static unsigned char file_fulltick_bits[] = {
1490    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1491    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1492    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1493 } -maskdata $filemask
1494
1495 image create bitmap file_parttick -background white -foreground "#005050" -data {
1496 #define parttick_width 14
1497 #define parttick_height 15
1498 static unsigned char parttick_bits[] = {
1499    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1500    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1501    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1502 } -maskdata $filemask
1503
1504 image create bitmap file_question -background white -foreground black -data {
1505 #define file_question_width 14
1506 #define file_question_height 15
1507 static unsigned char file_question_bits[] = {
1508    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1509    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1510    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1511 } -maskdata $filemask
1512
1513 image create bitmap file_removed -background white -foreground red -data {
1514 #define file_removed_width 14
1515 #define file_removed_height 15
1516 static unsigned char file_removed_bits[] = {
1517    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1518    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1519    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1520 } -maskdata $filemask
1521
1522 image create bitmap file_merge -background white -foreground blue -data {
1523 #define file_merge_width 14
1524 #define file_merge_height 15
1525 static unsigned char file_merge_bits[] = {
1526    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1527    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1528    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1529 } -maskdata $filemask
1530
1531 set ui_index .vpane.files.index.list
1532 set ui_other .vpane.files.other.list
1533 set max_status_desc 0
1534 foreach i {
1535                 {__ i plain    "Unmodified"}
1536                 {_M i mod      "Modified"}
1537                 {M_ i fulltick "Included in commit"}
1538                 {MM i parttick "Partially included"}
1539
1540                 {_O o plain    "Untracked"}
1541                 {A_ o fulltick "Added by commit"}
1542                 {AM o parttick "Partially added"}
1543                 {AD o question "Added (but now gone)"}
1544
1545                 {_D i question "Missing"}
1546                 {D_ i removed  "Removed by commit"}
1547                 {DD i removed  "Removed by commit"}
1548                 {DO i removed  "Removed (still exists)"}
1549
1550                 {UM i merge    "Merge conflicts"}
1551                 {U_ i merge    "Merge conflicts"}
1552         } {
1553         if {$max_status_desc < [string length [lindex $i 3]]} {
1554                 set max_status_desc [string length [lindex $i 3]]
1555         }
1556         if {[lindex $i 1] eq {i}} {
1557                 set all_cols([lindex $i 0]) $ui_index
1558         } else {
1559                 set all_cols([lindex $i 0]) $ui_other
1560         }
1561         set all_icons([lindex $i 0]) file_[lindex $i 2]
1562         set all_descs([lindex $i 0]) [lindex $i 3]
1563 }
1564 unset filemask i
1565
1566 ######################################################################
1567 ##
1568 ## util
1569
1570 proc is_MacOSX {} {
1571         global tcl_platform tk_library
1572         if {$tcl_platform(platform) eq {unix}
1573                 && $tcl_platform(os) eq {Darwin}
1574                 && [string match /Library/Frameworks/* $tk_library]} {
1575                 return 1
1576         }
1577         return 0
1578 }
1579
1580 proc bind_button3 {w cmd} {
1581         bind $w <Any-Button-3> $cmd
1582         if {[is_MacOSX]} {
1583                 bind $w <Control-Button-1> $cmd
1584         }
1585 }
1586
1587 proc incr_font_size {font {amt 1}} {
1588         set sz [font configure $font -size]
1589         incr sz $amt
1590         font configure $font -size $sz
1591         font configure ${font}bold -size $sz
1592 }
1593
1594 proc hook_failed_popup {hook msg} {
1595         global gitdir appname
1596
1597         set w .hookfail
1598         toplevel $w
1599
1600         frame $w.m
1601         label $w.m.l1 -text "$hook hook failed:" \
1602                 -anchor w \
1603                 -justify left \
1604                 -font font_uibold
1605         text $w.m.t \
1606                 -background white -borderwidth 1 \
1607                 -relief sunken \
1608                 -width 80 -height 10 \
1609                 -font font_diff \
1610                 -yscrollcommand [list $w.m.sby set]
1611         label $w.m.l2 \
1612                 -text {You must correct the above errors before committing.} \
1613                 -anchor w \
1614                 -justify left \
1615                 -font font_uibold
1616         scrollbar $w.m.sby -command [list $w.m.t yview]
1617         pack $w.m.l1 -side top -fill x
1618         pack $w.m.l2 -side bottom -fill x
1619         pack $w.m.sby -side right -fill y
1620         pack $w.m.t -side left -fill both -expand 1
1621         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1622
1623         $w.m.t insert 1.0 $msg
1624         $w.m.t conf -state disabled
1625
1626         button $w.ok -text OK \
1627                 -width 15 \
1628                 -font font_ui \
1629                 -command "destroy $w"
1630         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1631
1632         bind $w <Visibility> "grab $w; focus $w"
1633         bind $w <Key-Return> "destroy $w"
1634         wm title $w "$appname ([lindex [file split \
1635                 [file normalize [file dirname $gitdir]]] \
1636                 end]): error"
1637         tkwait window $w
1638 }
1639
1640 set next_console_id 0
1641
1642 proc new_console {short_title long_title} {
1643         global next_console_id console_data
1644         set w .console[incr next_console_id]
1645         set console_data($w) [list $short_title $long_title]
1646         return [console_init $w]
1647 }
1648
1649 proc console_init {w} {
1650         global console_cr console_data
1651         global gitdir appname M1B
1652
1653         set console_cr($w) 1.0
1654         toplevel $w
1655         frame $w.m
1656         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1657                 -anchor w \
1658                 -justify left \
1659                 -font font_uibold
1660         text $w.m.t \
1661                 -background white -borderwidth 1 \
1662                 -relief sunken \
1663                 -width 80 -height 10 \
1664                 -font font_diff \
1665                 -state disabled \
1666                 -yscrollcommand [list $w.m.sby set]
1667         label $w.m.s -text {Working... please wait...} \
1668                 -anchor w \
1669                 -justify left \
1670                 -font font_uibold
1671         scrollbar $w.m.sby -command [list $w.m.t yview]
1672         pack $w.m.l1 -side top -fill x
1673         pack $w.m.s -side bottom -fill x
1674         pack $w.m.sby -side right -fill y
1675         pack $w.m.t -side left -fill both -expand 1
1676         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1677
1678         menu $w.ctxm -tearoff 0
1679         $w.ctxm add command -label "Copy" \
1680                 -font font_ui \
1681                 -command "tk_textCopy $w.m.t"
1682         $w.ctxm add command -label "Select All" \
1683                 -font font_ui \
1684                 -command "$w.m.t tag add sel 0.0 end"
1685         $w.ctxm add command -label "Copy All" \
1686                 -font font_ui \
1687                 -command "
1688                         $w.m.t tag add sel 0.0 end
1689                         tk_textCopy $w.m.t
1690                         $w.m.t tag remove sel 0.0 end
1691                 "
1692
1693         button $w.ok -text {Close} \
1694                 -font font_ui \
1695                 -state disabled \
1696                 -command "destroy $w"
1697         pack $w.ok -side bottom -anchor e -pady 10 -padx 10
1698
1699         bind_button3 $w.m.t "tk_popup $w.ctxm %X %Y"
1700         bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1701         bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1702         bind $w <Visibility> "focus $w"
1703         wm title $w "$appname ([lindex [file split \
1704                 [file normalize [file dirname $gitdir]]] \
1705                 end]): [lindex $console_data($w) 0]"
1706         return $w
1707 }
1708
1709 proc console_exec {w cmd {after {}}} {
1710         global tcl_platform
1711
1712         # -- Windows tosses the enviroment when we exec our child.
1713         #    But most users need that so we have to relogin. :-(
1714         #
1715         if {$tcl_platform(platform) eq {windows}} {
1716                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1717         }
1718
1719         # -- Tcl won't let us redirect both stdout and stderr to
1720         #    the same pipe.  So pass it through cat...
1721         #
1722         set cmd [concat | $cmd |& cat]
1723
1724         set fd_f [open $cmd r]
1725         fconfigure $fd_f -blocking 0 -translation binary
1726         fileevent $fd_f readable [list console_read $w $fd_f $after]
1727 }
1728
1729 proc console_read {w fd after} {
1730         global console_cr console_data
1731
1732         set buf [read $fd]
1733         if {$buf ne {}} {
1734                 if {![winfo exists $w]} {console_init $w}
1735                 $w.m.t conf -state normal
1736                 set c 0
1737                 set n [string length $buf]
1738                 while {$c < $n} {
1739                         set cr [string first "\r" $buf $c]
1740                         set lf [string first "\n" $buf $c]
1741                         if {$cr < 0} {set cr [expr {$n + 1}]}
1742                         if {$lf < 0} {set lf [expr {$n + 1}]}
1743
1744                         if {$lf < $cr} {
1745                                 $w.m.t insert end [string range $buf $c $lf]
1746                                 set console_cr($w) [$w.m.t index {end -1c}]
1747                                 set c $lf
1748                                 incr c
1749                         } else {
1750                                 $w.m.t delete $console_cr($w) end
1751                                 $w.m.t insert end "\n"
1752                                 $w.m.t insert end [string range $buf $c $cr]
1753                                 set c $cr
1754                                 incr c
1755                         }
1756                 }
1757                 $w.m.t conf -state disabled
1758                 $w.m.t see end
1759         }
1760
1761         fconfigure $fd -blocking 1
1762         if {[eof $fd]} {
1763                 if {[catch {close $fd}]} {
1764                         if {![winfo exists $w]} {console_init $w}
1765                         $w.m.s conf -background red -text {Error: Command Failed}
1766                         $w.ok conf -state normal
1767                         set ok 0
1768                 } elseif {[winfo exists $w]} {
1769                         $w.m.s conf -background green -text {Success}
1770                         $w.ok conf -state normal
1771                         set ok 1
1772                 }
1773                 array unset console_cr $w
1774                 array unset console_data $w
1775                 if {$after ne {}} {
1776                         uplevel #0 $after $ok
1777                 }
1778                 return
1779         }
1780         fconfigure $fd -blocking 0
1781 }
1782
1783 ######################################################################
1784 ##
1785 ## ui commands
1786
1787 set starting_gitk_msg {Please wait... Starting gitk...}
1788
1789 proc do_gitk {} {
1790         global tcl_platform ui_status_value starting_gitk_msg
1791
1792         set ui_status_value $starting_gitk_msg
1793         after 10000 {
1794                 if {$ui_status_value eq $starting_gitk_msg} {
1795                         set ui_status_value {Ready.}
1796                 }
1797         }
1798
1799         if {$tcl_platform(platform) eq {windows}} {
1800                 exec sh -c gitk &
1801         } else {
1802                 exec gitk &
1803         }
1804 }
1805
1806 proc do_repack {} {
1807         set w [new_console "repack" "Repacking the object database"]
1808         set cmd [list git repack]
1809         lappend cmd -a
1810         lappend cmd -d
1811         console_exec $w $cmd
1812 }
1813
1814 set is_quitting 0
1815
1816 proc do_quit {} {
1817         global gitdir ui_comm is_quitting repo_config
1818
1819         if {$is_quitting} return
1820         set is_quitting 1
1821
1822         # -- Stash our current commit buffer.
1823         #
1824         set save [file join $gitdir GITGUI_MSG]
1825         set msg [string trim [$ui_comm get 0.0 end]]
1826         if {[$ui_comm edit modified] && $msg ne {}} {
1827                 catch {
1828                         set fd [open $save w]
1829                         puts $fd [string trim [$ui_comm get 0.0 end]]
1830                         close $fd
1831                 }
1832         } elseif {$msg eq {} && [file exists $save]} {
1833                 file delete $save
1834         }
1835
1836         # -- Stash our current window geometry into this repository.
1837         #
1838         set cfg_geometry [list]
1839         lappend cfg_geometry [wm geometry .]
1840         lappend cfg_geometry [lindex [.vpane sash coord 0] 1]
1841         lappend cfg_geometry [lindex [.vpane.files sash coord 0] 0]
1842         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
1843                 set rc_geometry {}
1844         }
1845         if {$cfg_geometry ne $rc_geometry} {
1846                 catch {exec git repo-config gui.geometry $cfg_geometry}
1847         }
1848
1849         destroy .
1850 }
1851
1852 proc do_rescan {} {
1853         rescan {set ui_status_value {Ready.}}
1854 }
1855
1856 proc do_include_all {} {
1857         global file_states current_diff
1858
1859         if {![lock_index begin-update]} return
1860
1861         set pathList [list]
1862         set after {}
1863         foreach path [array names file_states] {
1864                 switch -- [lindex $file_states($path) 0] {
1865                 AM -
1866                 MM -
1867                 _M -
1868                 _D {
1869                         lappend pathList $path
1870                         if {$path eq $current_diff} {
1871                                 set after {reshow_diff;}
1872                         }
1873                 }
1874                 }
1875         }
1876         if {$pathList eq {}} {
1877                 unlock_index
1878         } else {
1879                 update_index \
1880                         "Including all modified files" \
1881                         $pathList \
1882                         [concat $after {set ui_status_value {Ready to commit.}}]
1883         }
1884 }
1885
1886 set GIT_COMMITTER_IDENT {}
1887
1888 proc do_signoff {} {
1889         global ui_comm GIT_COMMITTER_IDENT
1890
1891         if {$GIT_COMMITTER_IDENT eq {}} {
1892                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1893                         error_popup "Unable to obtain your identity:\n\n$err"
1894                         return
1895                 }
1896                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1897                         $me me GIT_COMMITTER_IDENT]} {
1898                         error_popup "Invalid GIT_COMMITTER_IDENT:\n\n$me"
1899                         return
1900                 }
1901         }
1902
1903         set sob "Signed-off-by: $GIT_COMMITTER_IDENT"
1904         set last [$ui_comm get {end -1c linestart} {end -1c}]
1905         if {$last ne $sob} {
1906                 $ui_comm edit separator
1907                 if {$last ne {}
1908                         && ![regexp {^[A-Z][A-Za-z]*-[A-Za-z-]+: *} $last]} {
1909                         $ui_comm insert end "\n"
1910                 }
1911                 $ui_comm insert end "\n$sob"
1912                 $ui_comm edit separator
1913                 $ui_comm see end
1914         }
1915 }
1916
1917 proc do_amend_last {} {
1918         load_last_commit
1919 }
1920
1921 proc do_commit {} {
1922         commit_tree
1923 }
1924
1925 proc do_options {} {
1926         global appname gitdir font_descs
1927         global repo_config global_config
1928         global repo_config_new global_config_new
1929
1930         array unset repo_config_new
1931         array unset global_config_new
1932         foreach name [array names repo_config] {
1933                 set repo_config_new($name) $repo_config($name)
1934         }
1935         load_config 1
1936         foreach name [array names repo_config] {
1937                 switch -- $name {
1938                 gui.diffcontext {continue}
1939                 }
1940                 set repo_config_new($name) $repo_config($name)
1941         }
1942         foreach name [array names global_config] {
1943                 set global_config_new($name) $global_config($name)
1944         }
1945         set reponame [lindex [file split \
1946                 [file normalize [file dirname $gitdir]]] \
1947                 end]
1948
1949         set w .options_editor
1950         toplevel $w
1951         wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
1952
1953         label $w.header -text "$appname Options" \
1954                 -font font_uibold
1955         pack $w.header -side top -fill x
1956
1957         frame $w.buttons
1958         button $w.buttons.restore -text {Restore Defaults} \
1959                 -font font_ui \
1960                 -command do_restore_defaults
1961         pack $w.buttons.restore -side left
1962         button $w.buttons.save -text Save \
1963                 -font font_ui \
1964                 -command [list do_save_config $w]
1965         pack $w.buttons.save -side right
1966         button $w.buttons.cancel -text {Cancel} \
1967                 -font font_ui \
1968                 -command [list destroy $w]
1969         pack $w.buttons.cancel -side right
1970         pack $w.buttons -side bottom -fill x -pady 10 -padx 10
1971
1972         labelframe $w.repo -text "$reponame Repository" \
1973                 -font font_ui \
1974                 -relief raised -borderwidth 2
1975         labelframe $w.global -text {Global (All Repositories)} \
1976                 -font font_ui \
1977                 -relief raised -borderwidth 2
1978         pack $w.repo -side left -fill both -expand 1 -pady 5 -padx 5
1979         pack $w.global -side right -fill both -expand 1 -pady 5 -padx 5
1980
1981         foreach option {
1982                 {b partialinclude {Allow Partially Included Files}}
1983                 {b pullsummary {Show Pull Summary}}
1984                 {b trustmtime  {Trust File Modification Timestamps}}
1985                 {i diffcontext {Number of Diff Context Lines}}
1986                 } {
1987                 set type [lindex $option 0]
1988                 set name [lindex $option 1]
1989                 set text [lindex $option 2]
1990                 foreach f {repo global} {
1991                         switch $type {
1992                         b {
1993                                 checkbutton $w.$f.$name -text $text \
1994                                         -variable ${f}_config_new(gui.$name) \
1995                                         -onvalue true \
1996                                         -offvalue false \
1997                                         -font font_ui
1998                                 pack $w.$f.$name -side top -anchor w
1999                         }
2000                         i {
2001                                 frame $w.$f.$name
2002                                 label $w.$f.$name.l -text "$text:" -font font_ui
2003                                 pack $w.$f.$name.l -side left -anchor w -fill x
2004                                 spinbox $w.$f.$name.v \
2005                                         -textvariable ${f}_config_new(gui.$name) \
2006                                         -from 1 -to 99 -increment 1 \
2007                                         -width 3 \
2008                                         -font font_ui
2009                                 pack $w.$f.$name.v -side right -anchor e
2010                                 pack $w.$f.$name -side top -anchor w -fill x
2011                         }
2012                         }
2013                 }
2014         }
2015
2016         set all_fonts [lsort [font families]]
2017         foreach option $font_descs {
2018                 set name [lindex $option 0]
2019                 set font [lindex $option 1]
2020                 set text [lindex $option 2]
2021
2022                 set global_config_new(gui.$font^^family) \
2023                         [font configure $font -family]
2024                 set global_config_new(gui.$font^^size) \
2025                         [font configure $font -size]
2026
2027                 frame $w.global.$name
2028                 label $w.global.$name.l -text "$text:" -font font_ui
2029                 pack $w.global.$name.l -side left -anchor w -fill x
2030                 eval tk_optionMenu $w.global.$name.family \
2031                         global_config_new(gui.$font^^family) \
2032                         $all_fonts
2033                 spinbox $w.global.$name.size \
2034                         -textvariable global_config_new(gui.$font^^size) \
2035                         -from 2 -to 80 -increment 1 \
2036                         -width 3 \
2037                         -font font_ui
2038                 pack $w.global.$name.size -side right -anchor e
2039                 pack $w.global.$name.family -side right -anchor e
2040                 pack $w.global.$name -side top -anchor w -fill x
2041         }
2042
2043         bind $w <Visibility> "grab $w; focus $w"
2044         bind $w <Key-Escape> "destroy $w"
2045         wm title $w "$appname ($reponame): Options"
2046         tkwait window $w
2047 }
2048
2049 proc do_restore_defaults {} {
2050         global font_descs default_config repo_config
2051         global repo_config_new global_config_new
2052
2053         foreach name [array names default_config] {
2054                 set repo_config_new($name) $default_config($name)
2055                 set global_config_new($name) $default_config($name)
2056         }
2057
2058         foreach option $font_descs {
2059                 set name [lindex $option 0]
2060                 set repo_config(gui.$name) $default_config(gui.$name)
2061         }
2062         apply_config
2063
2064         foreach option $font_descs {
2065                 set name [lindex $option 0]
2066                 set font [lindex $option 1]
2067                 set global_config_new(gui.$font^^family) \
2068                         [font configure $font -family]
2069                 set global_config_new(gui.$font^^size) \
2070                         [font configure $font -size]
2071         }
2072 }
2073
2074 proc do_save_config {w} {
2075         if {[catch {save_config} err]} {
2076                 error_popup "Failed to completely save options:\n\n$err"
2077         }
2078         reshow_diff
2079         destroy $w
2080 }
2081
2082 proc do_windows_shortcut {} {
2083         global gitdir appname argv0
2084
2085         set reponame [lindex [file split \
2086                 [file normalize [file dirname $gitdir]]] \
2087                 end]
2088
2089         if {[catch {
2090                 set desktop [exec cygpath \
2091                         --windows \
2092                         --absolute \
2093                         --long-name \
2094                         --desktop]
2095                 }]} {
2096                         set desktop .
2097         }
2098         set fn [tk_getSaveFile \
2099                 -parent . \
2100                 -title "$appname ($reponame): Create Desktop Icon" \
2101                 -initialdir $desktop \
2102                 -initialfile "Git $reponame.bat"]
2103         if {$fn != {}} {
2104                 if {[catch {
2105                                 set fd [open $fn w]
2106                                 set sh [exec cygpath \
2107                                         --windows \
2108                                         --absolute \
2109                                         --long-name \
2110                                         /bin/sh]
2111                                 set me [exec cygpath \
2112                                         --unix \
2113                                         --absolute \
2114                                         $argv0]
2115                                 set gd [exec cygpath \
2116                                         --unix \
2117                                         --absolute \
2118                                         $gitdir]
2119                                 regsub -all ' $me "'\\''" me
2120                                 regsub -all ' $gd "'\\''" gd
2121                                 puts -nonewline $fd "\"$sh\" --login -c \""
2122                                 puts -nonewline $fd "GIT_DIR='$gd'"
2123                                 puts -nonewline $fd " '$me'"
2124                                 puts $fd "&\""
2125                                 close $fd
2126                         } err]} {
2127                         error_popup "Cannot write script:\n\n$err"
2128                 }
2129         }
2130 }
2131
2132 proc do_macosx_app {} {
2133         global gitdir appname argv0 env
2134
2135         set reponame [lindex [file split \
2136                 [file normalize [file dirname $gitdir]]] \
2137                 end]
2138
2139         set fn [tk_getSaveFile \
2140                 -parent . \
2141                 -title "$appname ($reponame): Create Desktop Icon" \
2142                 -initialdir [file join $env(HOME) Desktop] \
2143                 -initialfile "Git $reponame.app"]
2144         if {$fn != {}} {
2145                 if {[catch {
2146                                 set Contents [file join $fn Contents]
2147                                 set MacOS [file join $Contents MacOS]
2148                                 set exe [file join $MacOS git-gui]
2149
2150                                 file mkdir $MacOS
2151
2152                                 set fd [open [file join $Contents PkgInfo] w]
2153                                 puts -nonewline $fd {APPL????}
2154                                 close $fd
2155
2156                                 set fd [open [file join $Contents Info.plist] w]
2157                                 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2158 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2159 <plist version="1.0">
2160 <dict>
2161         <key>CFBundleDevelopmentRegion</key>
2162         <string>English</string>
2163         <key>CFBundleExecutable</key>
2164         <string>git-gui</string>
2165         <key>CFBundleIdentifier</key>
2166         <string>org.spearce.git-gui</string>
2167         <key>CFBundleInfoDictionaryVersion</key>
2168         <string>6.0</string>
2169         <key>CFBundlePackageType</key>
2170         <string>APPL</string>
2171         <key>CFBundleSignature</key>
2172         <string>????</string>
2173         <key>CFBundleVersion</key>
2174         <string>1.0</string>
2175         <key>NSPrincipalClass</key>
2176         <string>NSApplication</string>
2177 </dict>
2178 </plist>}
2179                                 close $fd
2180
2181                                 set fd [open $exe w]
2182                                 set gd [file normalize $gitdir]
2183                                 set ep [file normalize [exec git --exec-path]]
2184                                 regsub -all ' $gd "'\\''" gd
2185                                 regsub -all ' $ep "'\\''" ep
2186                                 puts $fd "#!/bin/sh"
2187                                 foreach name [array names env] {
2188                                         if {[string match GIT_* $name]} {
2189                                                 regsub -all ' $env($name) "'\\''" v
2190                                                 puts $fd "export $name='$v'"
2191                                         }
2192                                 }
2193                                 puts $fd "export PATH='$ep':\$PATH"
2194                                 puts $fd "export GIT_DIR='$gd'"
2195                                 puts $fd "exec [file normalize $argv0]"
2196                                 close $fd
2197
2198                                 file attributes $exe -permissions u+x,g+x,o+x
2199                         } err]} {
2200                         error_popup "Cannot write icon:\n\n$err"
2201                 }
2202         }
2203 }
2204
2205 proc toggle_or_diff {w x y} {
2206         global file_lists current_diff ui_index ui_other
2207         global last_clicked selected_paths
2208
2209         set pos [split [$w index @$x,$y] .]
2210         set lno [lindex $pos 0]
2211         set col [lindex $pos 1]
2212         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2213         if {$path eq {}} {
2214                 set last_clicked {}
2215                 return
2216         }
2217
2218         set last_clicked [list $w $lno]
2219         array unset selected_paths
2220         $ui_index tag remove in_sel 0.0 end
2221         $ui_other tag remove in_sel 0.0 end
2222
2223         if {$col == 0} {
2224                 if {$current_diff eq $path} {
2225                         set after {reshow_diff;}
2226                 } else {
2227                         set after {}
2228                 }
2229                 update_index \
2230                         "Including [short_path $path]" \
2231                         [list $path] \
2232                         [concat $after {set ui_status_value {Ready.}}]
2233         } else {
2234                 show_diff $path $w $lno
2235         }
2236 }
2237
2238 proc add_one_to_selection {w x y} {
2239         global file_lists
2240         global last_clicked selected_paths
2241
2242         set pos [split [$w index @$x,$y] .]
2243         set lno [lindex $pos 0]
2244         set col [lindex $pos 1]
2245         set path [lindex $file_lists($w) [expr {$lno - 1}]]
2246         if {$path eq {}} {
2247                 set last_clicked {}
2248                 return
2249         }
2250
2251         set last_clicked [list $w $lno]
2252         if {[catch {set in_sel $selected_paths($path)}]} {
2253                 set in_sel 0
2254         }
2255         if {$in_sel} {
2256                 unset selected_paths($path)
2257                 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2258         } else {
2259                 set selected_paths($path) 1
2260                 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2261         }
2262 }
2263
2264 proc add_range_to_selection {w x y} {
2265         global file_lists
2266         global last_clicked selected_paths
2267
2268         if {[lindex $last_clicked 0] ne $w} {
2269                 toggle_or_diff $w $x $y
2270                 return
2271         }
2272
2273         set pos [split [$w index @$x,$y] .]
2274         set lno [lindex $pos 0]
2275         set lc [lindex $last_clicked 1]
2276         if {$lc < $lno} {
2277                 set begin $lc
2278                 set end $lno
2279         } else {
2280                 set begin $lno
2281                 set end $lc
2282         }
2283
2284         foreach path [lrange $file_lists($w) \
2285                 [expr {$begin - 1}] \
2286                 [expr {$end - 1}]] {
2287                 set selected_paths($path) 1
2288         }
2289         $w tag add in_sel $begin.0 [expr {$end + 1}].0
2290 }
2291
2292 ######################################################################
2293 ##
2294 ## config defaults
2295
2296 set cursor_ptr arrow
2297 font create font_diff -family Courier -size 10
2298 font create font_ui
2299 catch {
2300         label .dummy
2301         eval font configure font_ui [font actual [.dummy cget -font]]
2302         destroy .dummy
2303 }
2304
2305 font create font_uibold
2306 font create font_diffbold
2307
2308 set M1B M1
2309 set M1T M1
2310 if {$tcl_platform(platform) eq {windows}} {
2311         set M1B Control
2312         set M1T Ctrl
2313 } elseif {[is_MacOSX]} {
2314         set M1B M1
2315         set M1T Cmd
2316 }
2317
2318 proc apply_config {} {
2319         global repo_config font_descs
2320
2321         foreach option $font_descs {
2322                 set name [lindex $option 0]
2323                 set font [lindex $option 1]
2324                 if {[catch {
2325                         foreach {cn cv} $repo_config(gui.$name) {
2326                                 font configure $font $cn $cv
2327                         }
2328                         } err]} {
2329                         error_popup "Invalid font specified in gui.$name:\n\n$err"
2330                 }
2331                 foreach {cn cv} [font configure $font] {
2332                         font configure ${font}bold $cn $cv
2333                 }
2334                 font configure ${font}bold -weight bold
2335         }
2336 }
2337
2338 set default_config(gui.trustmtime) false
2339 set default_config(gui.pullsummary) true
2340 set default_config(gui.partialinclude) false
2341 set default_config(gui.diffcontext) 5
2342 set default_config(gui.fontui) [font configure font_ui]
2343 set default_config(gui.fontdiff) [font configure font_diff]
2344 set font_descs {
2345         {fontui   font_ui   {Main Font}}
2346         {fontdiff font_diff {Diff/Console Font}}
2347 }
2348 load_config 0
2349 apply_config
2350
2351 ######################################################################
2352 ##
2353 ## ui construction
2354
2355 # -- Menu Bar
2356 menu .mbar -tearoff 0
2357 .mbar add cascade -label Project -menu .mbar.project
2358 .mbar add cascade -label Edit -menu .mbar.edit
2359 .mbar add cascade -label Commit -menu .mbar.commit
2360 if {!$single_commit} {
2361         .mbar add cascade -label Fetch -menu .mbar.fetch
2362         .mbar add cascade -label Pull -menu .mbar.pull
2363         .mbar add cascade -label Push -menu .mbar.push
2364 }
2365 . configure -menu .mbar
2366
2367 # -- Project Menu
2368 menu .mbar.project
2369 .mbar.project add command -label Visualize \
2370         -command do_gitk \
2371         -font font_ui
2372 if {!$single_commit} {
2373         .mbar.project add command -label {Repack Database} \
2374                 -command do_repack \
2375                 -font font_ui
2376
2377         if {$tcl_platform(platform) eq {windows}} {
2378                 .mbar.project add command \
2379                         -label {Create Desktop Icon} \
2380                         -command do_windows_shortcut \
2381                         -font font_ui
2382         } elseif {[is_MacOSX]} {
2383                 .mbar.project add command \
2384                         -label {Create Desktop Icon} \
2385                         -command do_macosx_app \
2386                         -font font_ui
2387         }
2388 }
2389 .mbar.project add command -label Quit \
2390         -command do_quit \
2391         -accelerator $M1T-Q \
2392         -font font_ui
2393
2394 # -- Edit Menu
2395 #
2396 menu .mbar.edit
2397 .mbar.edit add command -label Undo \
2398         -command {catch {[focus] edit undo}} \
2399         -accelerator $M1T-Z \
2400         -font font_ui
2401 .mbar.edit add command -label Redo \
2402         -command {catch {[focus] edit redo}} \
2403         -accelerator $M1T-Y \
2404         -font font_ui
2405 .mbar.edit add separator
2406 .mbar.edit add command -label Cut \
2407         -command {catch {tk_textCut [focus]}} \
2408         -accelerator $M1T-X \
2409         -font font_ui
2410 .mbar.edit add command -label Copy \
2411         -command {catch {tk_textCopy [focus]}} \
2412         -accelerator $M1T-C \
2413         -font font_ui
2414 .mbar.edit add command -label Paste \
2415         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2416         -accelerator $M1T-V \
2417         -font font_ui
2418 .mbar.edit add command -label Delete \
2419         -command {catch {[focus] delete sel.first sel.last}} \
2420         -accelerator Del \
2421         -font font_ui
2422 .mbar.edit add separator
2423 .mbar.edit add command -label {Select All} \
2424         -command {catch {[focus] tag add sel 0.0 end}} \
2425         -accelerator $M1T-A \
2426         -font font_ui
2427 .mbar.edit add separator
2428 .mbar.edit add command -label {Options...} \
2429         -command do_options \
2430         -font font_ui
2431
2432 # -- Commit Menu
2433 menu .mbar.commit
2434 .mbar.commit add command -label Rescan \
2435         -command do_rescan \
2436         -accelerator F5 \
2437         -font font_ui
2438 lappend disable_on_lock \
2439         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2440 .mbar.commit add command -label {Amend Last Commit} \
2441         -command do_amend_last \
2442         -font font_ui
2443 lappend disable_on_lock \
2444         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2445 .mbar.commit add command -label {Include All Files} \
2446         -command do_include_all \
2447         -accelerator $M1T-I \
2448         -font font_ui
2449 lappend disable_on_lock \
2450         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2451 .mbar.commit add command -label {Sign Off} \
2452         -command do_signoff \
2453         -accelerator $M1T-S \
2454         -font font_ui
2455 .mbar.commit add command -label Commit \
2456         -command do_commit \
2457         -accelerator $M1T-Return \
2458         -font font_ui
2459 lappend disable_on_lock \
2460         [list .mbar.commit entryconf [.mbar.commit index last] -state]
2461
2462 if {!$single_commit} {
2463         # -- Fetch Menu
2464         menu .mbar.fetch
2465
2466         # -- Pull Menu
2467         menu .mbar.pull
2468
2469         # -- Push Menu
2470         menu .mbar.push
2471 }
2472
2473 # -- Main Window Layout
2474 panedwindow .vpane -orient vertical
2475 panedwindow .vpane.files -orient horizontal
2476 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2477 pack .vpane -anchor n -side top -fill both -expand 1
2478
2479 # -- Index File List
2480 frame .vpane.files.index -height 100 -width 400
2481 label .vpane.files.index.title -text {Modified Files} \
2482         -background green \
2483         -font font_ui
2484 text $ui_index -background white -borderwidth 0 \
2485         -width 40 -height 10 \
2486         -font font_ui \
2487         -cursor $cursor_ptr \
2488         -yscrollcommand {.vpane.files.index.sb set} \
2489         -state disabled
2490 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2491 pack .vpane.files.index.title -side top -fill x
2492 pack .vpane.files.index.sb -side right -fill y
2493 pack $ui_index -side left -fill both -expand 1
2494 .vpane.files add .vpane.files.index -sticky nsew
2495
2496 # -- Other (Add) File List
2497 frame .vpane.files.other -height 100 -width 100
2498 label .vpane.files.other.title -text {Untracked Files} \
2499         -background red \
2500         -font font_ui
2501 text $ui_other -background white -borderwidth 0 \
2502         -width 40 -height 10 \
2503         -font font_ui \
2504         -cursor $cursor_ptr \
2505         -yscrollcommand {.vpane.files.other.sb set} \
2506         -state disabled
2507 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2508 pack .vpane.files.other.title -side top -fill x
2509 pack .vpane.files.other.sb -side right -fill y
2510 pack $ui_other -side left -fill both -expand 1
2511 .vpane.files add .vpane.files.other -sticky nsew
2512
2513 foreach i [list $ui_index $ui_other] {
2514         $i tag conf in_diff -font font_uibold
2515         $i tag conf in_sel \
2516                 -background [$i cget -foreground] \
2517                 -foreground [$i cget -background]
2518 }
2519 unset i
2520
2521 # -- Diff and Commit Area
2522 frame .vpane.lower -height 300 -width 400
2523 frame .vpane.lower.commarea
2524 frame .vpane.lower.diff -relief sunken -borderwidth 1
2525 pack .vpane.lower.commarea -side top -fill x
2526 pack .vpane.lower.diff -side bottom -fill both -expand 1
2527 .vpane add .vpane.lower -stick nsew
2528
2529 # -- Commit Area Buttons
2530 frame .vpane.lower.commarea.buttons
2531 label .vpane.lower.commarea.buttons.l -text {} \
2532         -anchor w \
2533         -justify left \
2534         -font font_ui
2535 pack .vpane.lower.commarea.buttons.l -side top -fill x
2536 pack .vpane.lower.commarea.buttons -side left -fill y
2537
2538 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2539         -command do_rescan \
2540         -font font_ui
2541 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2542 lappend disable_on_lock \
2543         {.vpane.lower.commarea.buttons.rescan conf -state}
2544
2545 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
2546         -command do_amend_last \
2547         -font font_ui
2548 pack .vpane.lower.commarea.buttons.amend -side top -fill x
2549 lappend disable_on_lock \
2550         {.vpane.lower.commarea.buttons.amend conf -state}
2551
2552 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2553         -command do_include_all \
2554         -font font_ui
2555 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2556 lappend disable_on_lock \
2557         {.vpane.lower.commarea.buttons.incall conf -state}
2558
2559 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2560         -command do_signoff \
2561         -font font_ui
2562 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2563
2564 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2565         -command do_commit \
2566         -font font_ui
2567 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2568 lappend disable_on_lock \
2569         {.vpane.lower.commarea.buttons.commit conf -state}
2570
2571 # -- Commit Message Buffer
2572 frame .vpane.lower.commarea.buffer
2573 set ui_comm .vpane.lower.commarea.buffer.t
2574 set ui_coml .vpane.lower.commarea.buffer.l
2575 label $ui_coml -text {Commit Message:} \
2576         -anchor w \
2577         -justify left \
2578         -font font_ui
2579 proc trace_commit_type {varname args} {
2580         global ui_coml commit_type
2581         switch -glob -- $commit_type {
2582         initial       {set txt {Initial Commit Message:}}
2583         amend         {set txt {Amended Commit Message:}}
2584         amend-initial {set txt {Amended Initial Commit Message:}}
2585         merge         {set txt {Merge Commit Message:}}
2586         *             {set txt {Commit Message:}}
2587         }
2588         $ui_coml conf -text $txt
2589 }
2590 trace add variable commit_type write trace_commit_type
2591 text $ui_comm -background white -borderwidth 1 \
2592         -undo true \
2593         -maxundo 20 \
2594         -autoseparators true \
2595         -relief sunken \
2596         -width 75 -height 9 -wrap none \
2597         -font font_diff \
2598         -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2599 scrollbar .vpane.lower.commarea.buffer.sby \
2600         -command [list $ui_comm yview]
2601 pack $ui_coml -side top -fill x
2602 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2603 pack $ui_comm -side left -fill y
2604 pack .vpane.lower.commarea.buffer -side left -fill y
2605
2606 # -- Commit Message Buffer Context Menu
2607 #
2608 set ctxm .vpane.lower.commarea.buffer.ctxm
2609 menu $ctxm -tearoff 0
2610 $ctxm add command \
2611         -label {Cut} \
2612         -font font_ui \
2613         -command {tk_textCut $ui_comm}
2614 $ctxm add command \
2615         -label {Copy} \
2616         -font font_ui \
2617         -command {tk_textCopy $ui_comm}
2618 $ctxm add command \
2619         -label {Paste} \
2620         -font font_ui \
2621         -command {tk_textPaste $ui_comm}
2622 $ctxm add command \
2623         -label {Delete} \
2624         -font font_ui \
2625         -command {$ui_comm delete sel.first sel.last}
2626 $ctxm add separator
2627 $ctxm add command \
2628         -label {Select All} \
2629         -font font_ui \
2630         -command {$ui_comm tag add sel 0.0 end}
2631 $ctxm add command \
2632         -label {Copy All} \
2633         -font font_ui \
2634         -command {
2635                 $ui_comm tag add sel 0.0 end
2636                 tk_textCopy $ui_comm
2637                 $ui_comm tag remove sel 0.0 end
2638         }
2639 $ctxm add separator
2640 $ctxm add command \
2641         -label {Sign Off} \
2642         -font font_ui \
2643         -command do_signoff
2644 bind_button3 $ui_comm "tk_popup $ctxm %X %Y"
2645
2646 # -- Diff Header
2647 set current_diff {}
2648 set diff_actions [list]
2649 proc trace_current_diff {varname args} {
2650         global current_diff diff_actions file_states
2651         if {$current_diff eq {}} {
2652                 set s {}
2653                 set f {}
2654                 set p {}
2655                 set o disabled
2656         } else {
2657                 set p $current_diff
2658                 set s [mapdesc [lindex $file_states($p) 0] $p]
2659                 set f {File:}
2660                 set p [escape_path $p]
2661                 set o normal
2662         }
2663
2664         .vpane.lower.diff.header.status configure -text $s
2665         .vpane.lower.diff.header.file configure -text $f
2666         .vpane.lower.diff.header.path configure -text $p
2667         foreach w $diff_actions {
2668                 uplevel #0 $w $o
2669         }
2670 }
2671 trace add variable current_diff write trace_current_diff
2672
2673 frame .vpane.lower.diff.header -background orange
2674 label .vpane.lower.diff.header.status \
2675         -background orange \
2676         -width $max_status_desc \
2677         -anchor w \
2678         -justify left \
2679         -font font_ui
2680 label .vpane.lower.diff.header.file \
2681         -background orange \
2682         -anchor w \
2683         -justify left \
2684         -font font_ui
2685 label .vpane.lower.diff.header.path \
2686         -background orange \
2687         -anchor w \
2688         -justify left \
2689         -font font_ui
2690 pack .vpane.lower.diff.header.status -side left
2691 pack .vpane.lower.diff.header.file -side left
2692 pack .vpane.lower.diff.header.path -fill x
2693 set ctxm .vpane.lower.diff.header.ctxm
2694 menu $ctxm -tearoff 0
2695 $ctxm add command \
2696         -label {Copy} \
2697         -font font_ui \
2698         -command {
2699                 clipboard clear
2700                 clipboard append \
2701                         -format STRING \
2702                         -type STRING \
2703                         -- $current_diff
2704         }
2705 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2706 bind_button3 .vpane.lower.diff.header.path "tk_popup $ctxm %X %Y"
2707
2708 # -- Diff Body
2709 frame .vpane.lower.diff.body
2710 set ui_diff .vpane.lower.diff.body.t
2711 text $ui_diff -background white -borderwidth 0 \
2712         -width 80 -height 15 -wrap none \
2713         -font font_diff \
2714         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
2715         -yscrollcommand {.vpane.lower.diff.body.sby set} \
2716         -state disabled
2717 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
2718         -command [list $ui_diff xview]
2719 scrollbar .vpane.lower.diff.body.sby -orient vertical \
2720         -command [list $ui_diff yview]
2721 pack .vpane.lower.diff.body.sbx -side bottom -fill x
2722 pack .vpane.lower.diff.body.sby -side right -fill y
2723 pack $ui_diff -side left -fill both -expand 1
2724 pack .vpane.lower.diff.header -side top -fill x
2725 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
2726
2727 $ui_diff tag conf dm -foreground red
2728 $ui_diff tag conf dp -foreground blue
2729 $ui_diff tag conf di -foreground {#00a000}
2730 $ui_diff tag conf dni -foreground {#a000a0}
2731 $ui_diff tag conf da -font font_diffbold
2732 $ui_diff tag conf bold -font font_diffbold
2733
2734 # -- Diff Body Context Menu
2735 #
2736 set ctxm .vpane.lower.diff.body.ctxm
2737 menu $ctxm -tearoff 0
2738 $ctxm add command \
2739         -label {Copy} \
2740         -font font_ui \
2741         -command {tk_textCopy $ui_diff}
2742 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2743 $ctxm add command \
2744         -label {Select All} \
2745         -font font_ui \
2746         -command {$ui_diff tag add sel 0.0 end}
2747 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2748 $ctxm add command \
2749         -label {Copy All} \
2750         -font font_ui \
2751         -command {
2752                 $ui_diff tag add sel 0.0 end
2753                 tk_textCopy $ui_diff
2754                 $ui_diff tag remove sel 0.0 end
2755         }
2756 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2757 $ctxm add separator
2758 $ctxm add command \
2759         -label {Decrease Font Size} \
2760         -font font_ui \
2761         -command {incr_font_size font_diff -1}
2762 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2763 $ctxm add command \
2764         -label {Increase Font Size} \
2765         -font font_ui \
2766         -command {incr_font_size font_diff 1}
2767 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2768 $ctxm add separator
2769 $ctxm add command \
2770         -label {Show Less Context} \
2771         -font font_ui \
2772         -command {if {$repo_config(gui.diffcontext) >= 2} {
2773                 incr repo_config(gui.diffcontext) -1
2774                 reshow_diff
2775         }}
2776 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2777 $ctxm add command \
2778         -label {Show More Context} \
2779         -font font_ui \
2780         -command {
2781                 incr repo_config(gui.diffcontext)
2782                 reshow_diff
2783         }
2784 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
2785 $ctxm add separator
2786 $ctxm add command -label {Options...} \
2787         -font font_ui \
2788         -command do_options
2789 bind_button3 $ui_diff "tk_popup $ctxm %X %Y"
2790
2791 # -- Status Bar
2792 #
2793 set ui_status_value {Initializing...}
2794 label .status -textvariable ui_status_value \
2795         -anchor w \
2796         -justify left \
2797         -borderwidth 1 \
2798         -relief sunken \
2799         -font font_ui
2800 pack .status -anchor w -side bottom -fill x
2801
2802 # -- Load geometry
2803 #
2804 catch {
2805 set gm $repo_config(gui.geometry)
2806 wm geometry . [lindex $gm 0]
2807 .vpane sash place 0 \
2808         [lindex [.vpane sash coord 0] 0] \
2809         [lindex $gm 1]
2810 .vpane.files sash place 0 \
2811         [lindex $gm 2] \
2812         [lindex [.vpane.files sash coord 0] 1]
2813 unset gm
2814 }
2815
2816 # -- Key Bindings
2817 #
2818 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
2819 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
2820 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
2821 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
2822 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
2823 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
2824 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
2825 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
2826 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
2827 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2828 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2829
2830 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
2831 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
2832 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
2833 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
2834 bind $ui_diff <$M1B-Key-v> {break}
2835 bind $ui_diff <$M1B-Key-V> {break}
2836 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
2837 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
2838 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
2839 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
2840 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
2841 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
2842
2843 bind .   <Destroy> do_quit
2844 bind all <Key-F5> do_rescan
2845 bind all <$M1B-Key-r> do_rescan
2846 bind all <$M1B-Key-R> do_rescan
2847 bind .   <$M1B-Key-s> do_signoff
2848 bind .   <$M1B-Key-S> do_signoff
2849 bind .   <$M1B-Key-i> do_include_all
2850 bind .   <$M1B-Key-I> do_include_all
2851 bind .   <$M1B-Key-Return> do_commit
2852 bind all <$M1B-Key-q> do_quit
2853 bind all <$M1B-Key-Q> do_quit
2854 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
2855 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
2856 foreach i [list $ui_index $ui_other] {
2857         bind $i <Button-1>       "toggle_or_diff         $i %x %y; break"
2858         bind $i <$M1B-Button-1>  "add_one_to_selection   $i %x %y; break"
2859         bind $i <Shift-Button-1> "add_range_to_selection $i %x %y; break"
2860 }
2861 unset i
2862
2863 set file_lists($ui_index) [list]
2864 set file_lists($ui_other) [list]
2865 set current_diff {}
2866
2867 wm title . "$appname ([file normalize [file dirname $gitdir]])"
2868 focus -force $ui_comm
2869 if {!$single_commit} {
2870         load_all_remotes
2871         populate_fetch_menu .mbar.fetch
2872         populate_pull_menu .mbar.pull
2873         populate_push_menu .mbar.push
2874 }
2875 after 1 do_rescan