git-gui

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