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