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

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