git.oblomov.eu Git - git/blob - git-gui

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