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