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 \
 201                         [list update_status_stage2 $fd_rf $final]
 202         }
 203 }
 204
 205 proc update_status_stage2 {fd final} {
 206         global gitdir PARENT commit_type
 207         global ui_index ui_other ui_status_value ui_comm
 208         global status_active
 209         global buf_rdi buf_rdf buf_rlo
 210
 211         if {$fd != {}} {
 212                 read $fd
 213                 if {![eof $fd]} return
 214                 close $fd
 215         }
 216
 217         set ls_others [list | git ls-files --others -z \
 218                 --exclude-per-directory=.gitignore]
 219         set info_exclude [file join $gitdir info exclude]
 220         if {[file readable $info_exclude]} {
 221                 lappend ls_others "--exclude-from=$info_exclude"
 222         }
 223
 224         set buf_rdi {}
 225         set buf_rdf {}
 226         set buf_rlo {}
 227
 228         set status_active 3
 229         set ui_status_value {Scanning for modified files ...}
 230         set fd_di [open "| git diff-index --cached -z $PARENT" r]
 231         set fd_df [open "| git diff-files -z" r]
 232         set fd_lo [open $ls_others r]
 233
 234         fconfigure $fd_di -blocking 0 -translation binary
 235         fconfigure $fd_df -blocking 0 -translation binary
 236         fconfigure $fd_lo -blocking 0 -translation binary
 237         fileevent $fd_di readable [list read_diff_index $fd_di $final]
 238         fileevent $fd_df readable [list read_diff_files $fd_df $final]
 239         fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
 240 }
 241
 242 proc load_message {file} {
 243         global gitdir ui_comm
 244
 245         set f [file join $gitdir $file]
 246         if {[file isfile $f]} {
 247                 if {[catch {set fd [open $f r]}]} {
 248                         return 0
 249                 }
 250                 set content [string trim [read $fd]]
 251                 close $fd
 252                 $ui_comm delete 0.0 end
 253                 $ui_comm insert end $content
 254                 return 1
 255         }
 256         return 0
 257 }
 258
 259 proc read_diff_index {fd final} {
 260         global buf_rdi
 261
 262         append buf_rdi [read $fd]
 263         set c 0
 264         set n [string length $buf_rdi]
 265         while {$c < $n} {
 266                 set z1 [string first "\0" $buf_rdi $c]
 267                 if {$z1 == -1} break
 268                 incr z1
 269                 set z2 [string first "\0" $buf_rdi $z1]
 270                 if {$z2 == -1} break
 271
 272                 set c $z2
 273                 incr z2 -1
 274                 display_file \
 275                         [string range $buf_rdi $z1 $z2] \
 276                         [string index $buf_rdi [expr $z1 - 2]]_
 277                 incr c
 278         }
 279         if {$c < $n} {
 280                 set buf_rdi [string range $buf_rdi $c end]
 281         } else {
 282                 set buf_rdi {}
 283         }
 284
 285         status_eof $fd buf_rdi $final
 286 }
 287
 288 proc read_diff_files {fd final} {
 289         global buf_rdf
 290
 291         append buf_rdf [read $fd]
 292         set c 0
 293         set n [string length $buf_rdf]
 294         while {$c < $n} {
 295                 set z1 [string first "\0" $buf_rdf $c]
 296                 if {$z1 == -1} break
 297                 incr z1
 298                 set z2 [string first "\0" $buf_rdf $z1]
 299                 if {$z2 == -1} break
 300
 301                 set c $z2
 302                 incr z2 -1
 303                 display_file \
 304                         [string range $buf_rdf $z1 $z2] \
 305                         _[string index $buf_rdf [expr $z1 - 2]]
 306                 incr c
 307         }
 308         if {$c < $n} {
 309                 set buf_rdf [string range $buf_rdf $c end]
 310         } else {
 311                 set buf_rdf {}
 312         }
 313
 314         status_eof $fd buf_rdf $final
 315 }
 316
 317 proc read_ls_others {fd final} {
 318         global buf_rlo
 319
 320         append buf_rlo [read $fd]
 321         set pck [split $buf_rlo "\0"]
 322         set buf_rlo [lindex $pck end]
 323         foreach p [lrange $pck 0 end-1] {
 324                 display_file $p _O
 325         }
 326         status_eof $fd buf_rlo $final
 327 }
 328
 329 proc status_eof {fd buf final} {
 330         global status_active ui_status_value
 331         upvar $buf to_clear
 332
 333         if {[eof $fd]} {
 334                 set to_clear {}
 335                 close $fd
 336
 337                 if {[incr status_active -1] == 0} {
 338                         display_all_files
 339                         unlock_index
 340                         reshow_diff
 341                         set ui_status_value $final
 342                 }
 343         }
 344 }
 345
 346 ######################################################################
 347 ##
 348 ## diff
 349
 350 proc clear_diff {} {
 351         global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
 352
 353         $ui_diff conf -state normal
 354         $ui_diff delete 0.0 end
 355         $ui_diff conf -state disabled
 356
 357         set ui_fname_value {}
 358         set ui_fstatus_value {}
 359
 360         $ui_index tag remove in_diff 0.0 end
 361         $ui_other tag remove in_diff 0.0 end
 362 }
 363
 364 proc reshow_diff {} {
 365         global ui_fname_value ui_status_value file_states
 366
 367         if {$ui_fname_value == {}
 368                 || [catch {set s $file_states($ui_fname_value)}]} {
 369                 clear_diff
 370         } else {
 371                 show_diff $ui_fname_value
 372         }
 373 }
 374
 375 proc show_diff {path {w {}} {lno {}}} {
 376         global file_states file_lists
 377         global PARENT diff_3way diff_active
 378         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 379
 380         if {$diff_active || ![lock_index read]} return
 381
 382         clear_diff
 383         if {$w == {} || $lno == {}} {
 384                 foreach w [array names file_lists] {
 385                         set lno [lsearch -sorted $file_lists($w) $path]
 386                         if {$lno >= 0} {
 387                                 incr lno
 388                                 break
 389                         }
 390                 }
 391         }
 392         if {$w != {} && $lno >= 1} {
 393                 $w tag add in_diff $lno.0 [expr $lno + 1].0
 394         }
 395
 396         set s $file_states($path)
 397         set m [lindex $s 0]
 398         set diff_3way 0
 399         set diff_active 1
 400         set ui_fname_value [escape_path $path]
 401         set ui_fstatus_value [mapdesc $m $path]
 402         set ui_status_value "Loading diff of [escape_path $path]..."
 403
 404         set cmd [list | git diff-index -p $PARENT -- $path]
 405         switch $m {
 406         MM {
 407                 set cmd [list | git diff-index -p -c $PARENT $path]
 408         }
 409         _O {
 410                 if {[catch {
 411                                 set fd [open $path r]
 412                                 set content [read $fd]
 413                                 close $fd
 414                         } err ]} {
 415                         set diff_active 0
 416                         unlock_index
 417                         set ui_status_value "Unable to display [escape_path $path]"
 418                         error_popup "Error loading file:\n\n$err"
 419                         return
 420                 }
 421                 $ui_diff conf -state normal
 422                 $ui_diff insert end $content
 423                 $ui_diff conf -state disabled
 424                 set diff_active 0
 425                 unlock_index
 426                 set ui_status_value {Ready.}
 427                 return
 428         }
 429         }
 430
 431         if {[catch {set fd [open $cmd r]} err]} {
 432                 set diff_active 0
 433                 unlock_index
 434                 set ui_status_value "Unable to display [escape_path $path]"
 435                 error_popup "Error loading diff:\n\n$err"
 436                 return
 437         }
 438
 439         fconfigure $fd -blocking 0 -translation auto
 440         fileevent $fd readable [list read_diff $fd]
 441 }
 442
 443 proc read_diff {fd} {
 444         global ui_diff ui_status_value diff_3way diff_active
 445
 446         while {[gets $fd line] >= 0} {
 447                 if {[string match {diff --git *} $line]} continue
 448                 if {[string match {diff --combined *} $line]} continue
 449                 if {[string match {--- *} $line]} continue
 450                 if {[string match {+++ *} $line]} continue
 451                 if {[string match index* $line]} {
 452                         if {[string first , $line] >= 0} {
 453                                 set diff_3way 1
 454                         }
 455                 }
 456
 457                 $ui_diff conf -state normal
 458                 if {!$diff_3way} {
 459                         set x [string index $line 0]
 460                         switch -- $x {
 461                         "@" {set tags da}
 462                         "+" {set tags dp}
 463                         "-" {set tags dm}
 464                         default {set tags {}}
 465                         }
 466                 } else {
 467                         set x [string range $line 0 1]
 468                         switch -- $x {
 469                         default {set tags {}}
 470                         "@@" {set tags da}
 471                         "++" {set tags dp; set x " +"}
 472                         " +" {set tags {di bold}; set x "++"}
 473                         "+ " {set tags dni; set x "-+"}
 474                         "--" {set tags dm; set x " -"}
 475                         " -" {set tags {dm bold}; set x "--"}
 476                         "- " {set tags di; set x "+-"}
 477                         default {set tags {}}
 478                         }
 479                         set line [string replace $line 0 1 $x]
 480                 }
 481                 $ui_diff insert end $line $tags
 482                 $ui_diff insert end "\n"
 483                 $ui_diff conf -state disabled
 484         }
 485
 486         if {[eof $fd]} {
 487                 close $fd
 488                 set diff_active 0
 489                 unlock_index
 490                 set ui_status_value {Ready.}
 491         }
 492 }
 493
 494 ######################################################################
 495 ##
 496 ## commit
 497
 498 proc load_last_commit {} {
 499         global HEAD PARENT commit_type ui_comm
 500
 501         if {$commit_type == {amend}} return
 502         if {$commit_type != {normal}} {
 503                 error_popup "Can't amend a $commit_type commit."
 504                 return
 505         }
 506
 507         set msg {}
 508         set parent {}
 509         set parent_count 0
 510         if {[catch {
 511                         set fd [open "| git cat-file commit $HEAD" r]
 512                         while {[gets $fd line] > 0} {
 513                                 if {[string match {parent *} $line]} {
 514                                         set parent [string range $line 7 end]
 515                                         incr parent_count
 516                                 }
 517                         }
 518                         set msg [string trim [read $fd]]
 519                         close $fd
 520                 } err]} {
 521                 error_popup "Error loading commit data for amend:\n\n$err"
 522                 return
 523         }
 524
 525         if {$parent_count == 0} {
 526                 set commit_type amend
 527                 set HEAD {}
 528                 set PARENT {}
 529                 update_status
 530         } elseif {$parent_count == 1} {
 531                 set commit_type amend
 532                 set PARENT $parent
 533                 $ui_comm delete 0.0 end
 534                 $ui_comm insert end $msg
 535                 $ui_comm edit modified false
 536                 $ui_comm edit reset
 537                 update_status
 538         } else {
 539                 error_popup {You can't amend a merge commit.}
 540                 return
 541         }
 542 }
 543
 544 proc commit_tree {} {
 545         global tcl_platform HEAD gitdir commit_type file_states
 546         global commit_active ui_status_value
 547         global ui_comm
 548
 549         if {$commit_active || ![lock_index update]} return
 550
 551         # -- Our in memory state should match the repository.
 552         #
 553         repository_state curHEAD cur_type
 554         if {$commit_type == {amend}
 555                 && $cur_type == {normal}
 556                 && $curHEAD == $HEAD} {
 557         } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
 558                 error_popup {Last scanned state does not match repository state.
 559
 560 Its highly likely that another Git program modified the
 561 repository since our last scan.  A rescan is required
 562 before committing.
 563 }
 564                 unlock_index
 565                 update_status
 566                 return
 567         }
 568
 569         # -- At least one file should differ in the index.
 570         #
 571         set files_ready 0
 572         foreach path [array names file_states] {
 573                 set s $file_states($path)
 574                 switch -glob -- [lindex $s 0] {
 575                 _? {continue}
 576                 A? -
 577                 D? -
 578                 M? {set files_ready 1; break}
 579                 U? {
 580                         error_popup "Unmerged files cannot be committed.
 581
 582 File [escape_path $path] has merge conflicts.
 583 You must resolve them and include the file before committing.
 584 "
 585                         unlock_index
 586                         return
 587                 }
 588                 default {
 589                         error_popup "Unknown file state [lindex $s 0] detected.
 590
 591 File [escape_path $path] cannot be committed by this program.
 592 "
 593                 }
 594                 }
 595         }
 596         if {!$files_ready} {
 597                 error_popup {No included files to commit.
 598
 599 You must include at least 1 file before you can commit.
 600 }
 601                 unlock_index
 602                 return
 603         }
 604
 605         # -- A message is required.
 606         #
 607         set msg [string trim [$ui_comm get 1.0 end]]
 608         if {$msg == {}} {
 609                 error_popup {Please supply a commit message.
 610
 611 A good commit message has the following format:
 612
 613 - First line: Describe in one sentance what you did.
 614 - Second line: Blank
 615 - Remaining lines: Describe why this change is good.
 616 }
 617                 unlock_index
 618                 return
 619         }
 620
 621         # -- Ask the pre-commit hook for the go-ahead.
 622         #
 623         set pchook [file join $gitdir hooks pre-commit]
 624         if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
 625                 set pchook [list sh -c \
 626                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 627         } elseif {[file executable $pchook]} {
 628                 set pchook [list $pchook]
 629         } else {
 630                 set pchook {}
 631         }
 632         if {$pchook != {} && [catch {eval exec $pchook} err]} {
 633                 hook_failed_popup pre-commit $err
 634                 unlock_index
 635                 return
 636         }
 637
 638         # -- Write the tree in the background.
 639         #
 640         set commit_active 1
 641         set ui_status_value {Committing changes...}
 642
 643         set fd_wt [open "| git write-tree" r]
 644         fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
 645 }
 646
 647 proc commit_stage2 {fd_wt curHEAD msg} {
 648         global single_commit gitdir HEAD PARENT commit_type
 649         global commit_active ui_status_value ui_comm
 650         global file_states
 651
 652         gets $fd_wt tree_id
 653         if {$tree_id == {} || [catch {close $fd_wt} err]} {
 654                 error_popup "write-tree failed:\n\n$err"
 655                 set commit_active 0
 656                 set ui_status_value {Commit failed.}
 657                 unlock_index
 658                 return
 659         }
 660
 661         # -- Create the commit.
 662         #
 663         set cmd [list git commit-tree $tree_id]
 664         if {$PARENT != {}} {
 665                 lappend cmd -p $PARENT
 666         }
 667         if {$commit_type == {merge}} {
 668                 if {[catch {
 669                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 670                                 while {[gets $fd_mh merge_head] >= 0} {
 671                                         lappend cmd -p $merge_head
 672                                 }
 673                                 close $fd_mh
 674                         } err]} {
 675                         error_popup "Loading MERGE_HEAD failed:\n\n$err"
 676                         set commit_active 0
 677                         set ui_status_value {Commit failed.}
 678                         unlock_index
 679                         return
 680                 }
 681         }
 682         if {$PARENT == {}} {
 683                 # git commit-tree writes to stderr during initial commit.
 684                 lappend cmd 2>/dev/null
 685         }
 686         lappend cmd << $msg
 687         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 688                 error_popup "commit-tree failed:\n\n$err"
 689                 set commit_active 0
 690                 set ui_status_value {Commit failed.}
 691                 unlock_index
 692                 return
 693         }
 694
 695         # -- Update the HEAD ref.
 696         #
 697         set reflogm commit
 698         if {$commit_type != {normal}} {
 699                 append reflogm " ($commit_type)"
 700         }
 701         set i [string first "\n" $msg]
 702         if {$i >= 0} {
 703                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
 704         } else {
 705                 append reflogm {: } $msg
 706         }
 707         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
 708         if {[catch {eval exec $cmd} err]} {
 709                 error_popup "update-ref failed:\n\n$err"
 710                 set commit_active 0
 711                 set ui_status_value {Commit failed.}
 712                 unlock_index
 713                 return
 714         }
 715
 716         # -- Cleanup after ourselves.
 717         #
 718         catch {file delete [file join $gitdir MERGE_HEAD]}
 719         catch {file delete [file join $gitdir MERGE_MSG]}
 720         catch {file delete [file join $gitdir SQUASH_MSG]}
 721         catch {file delete [file join $gitdir GITGUI_MSG]}
 722
 723         # -- Let rerere do its thing.
 724         #
 725         if {[file isdirectory [file join $gitdir rr-cache]]} {
 726                 catch {exec git rerere}
 727         }
 728
 729         $ui_comm delete 0.0 end
 730         $ui_comm edit modified false
 731         $ui_comm edit reset
 732
 733         if {$single_commit} do_quit
 734
 735         # -- Update status without invoking any git commands.
 736         #
 737         set commit_active 0
 738         set commit_type normal
 739         set HEAD $cmt_id
 740         set PARENT $cmt_id
 741
 742         foreach path [array names file_states] {
 743                 set s $file_states($path)
 744                 set m [lindex $s 0]
 745                 switch -glob -- $m {
 746                 A? -
 747                 M? -
 748                 D? {set m _[string index $m 1]}
 749                 }
 750
 751                 if {$m == {__}} {
 752                         unset file_states($path)
 753                 } else {
 754                         lset file_states($path) 0 $m
 755                 }
 756         }
 757
 758         display_all_files
 759         unlock_index
 760         reshow_diff
 761         set ui_status_value \
 762                 "Changes committed as [string range $cmt_id 0 7]."
 763 }
 764
 765 ######################################################################
 766 ##
 767 ## fetch pull push
 768
 769 proc fetch_from {remote} {
 770         set w [new_console "fetch $remote" \
 771                 "Fetching new changes from $remote"]
 772         set cmd [list git fetch]
 773         lappend cmd $remote
 774         console_exec $w $cmd
 775 }
 776
 777 proc pull_remote {remote branch} {
 778         global HEAD commit_type
 779         global file_states
 780
 781         if {![lock_index update]} return
 782
 783         # -- Our in memory state should match the repository.
 784         #
 785         repository_state curHEAD cur_type
 786         if {$commit_type != $cur_type || $HEAD != $curHEAD} {
 787                 error_popup {Last scanned state does not match repository state.
 788
 789 Its highly likely that another Git program modified the
 790 repository since our last scan.  A rescan is required
 791 before a pull can be started.
 792 }
 793                 unlock_index
 794                 update_status
 795                 return
 796         }
 797
 798         # -- No differences should exist before a pull.
 799         #
 800         if {[array size file_states] != 0} {
 801                 error_popup {Uncommitted but modified files are present.
 802
 803 You should not perform a pull with unmodified files in your working
 804 directory as Git would be unable to recover from an incorrect merge.
 805
 806 Commit or throw away all changes before starting a pull operation.
 807 }
 808                 unlock_index
 809                 return
 810         }
 811
 812         set w [new_console "pull $remote $branch" \
 813                 "Pulling new changes from branch $branch in $remote"]
 814         set cmd [list git pull]
 815         lappend cmd $remote
 816         lappend cmd $branch
 817         console_exec $w $cmd [list post_pull_remote $remote $branch]
 818 }
 819
 820 proc post_pull_remote {remote branch success} {
 821         global HEAD PARENT commit_type
 822         global ui_status_value
 823
 824         unlock_index
 825         if {$success} {
 826                 repository_state HEAD commit_type
 827                 set PARENT $HEAD
 828                 set $ui_status_value {Ready.}
 829         } else {
 830                 update_status \
 831                         "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 *           {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 \
1724         {.vpane.lower.commarea.buttons.rescan conf -state}
1725
1726 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1727         -command do_amend_last \
1728         -font $font_ui
1729 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1730 lappend disable_on_lock \
1731         {.vpane.lower.commarea.buttons.amend conf -state}
1732
1733 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1734         -command do_include_all \
1735         -font $font_ui
1736 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1737 lappend disable_on_lock \
1738         {.vpane.lower.commarea.buttons.incall conf -state}
1739
1740 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1741         -command do_signoff \
1742         -font $font_ui
1743 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1744
1745 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1746         -command do_commit \
1747         -font $font_ui
1748 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1749 lappend disable_on_lock \
1750         {.vpane.lower.commarea.buttons.commit conf -state}
1751
1752 # -- Commit Message Buffer
1753 frame .vpane.lower.commarea.buffer
1754 set ui_comm .vpane.lower.commarea.buffer.t
1755 set ui_coml .vpane.lower.commarea.buffer.l
1756 label $ui_coml -text {Commit Message:} \
1757         -anchor w \
1758         -justify left \
1759         -font $font_ui
1760 trace add variable commit_type write {uplevel #0 {
1761         switch -glob $commit_type \
1762         initial {$ui_coml conf -text {Initial Commit Message:}} \
1763         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1764         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1765         *       {$ui_coml conf -text {Commit Message:}}
1766 }}
1767 text $ui_comm -background white -borderwidth 1 \
1768         -undo true \
1769         -maxundo 20 \
1770         -autoseparators true \
1771         -relief sunken \
1772         -width 75 -height 9 -wrap none \
1773         -font $font_diff \
1774         -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1775         -cursor $maincursor
1776 scrollbar .vpane.lower.commarea.buffer.sby \
1777         -command [list $ui_comm yview]
1778 pack $ui_coml -side top -fill x
1779 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1780 pack $ui_comm -side left -fill y
1781 pack .vpane.lower.commarea.buffer -side left -fill y
1782
1783 # -- Diff Header
1784 set ui_fname_value {}
1785 set ui_fstatus_value {}
1786 frame .vpane.lower.diff.header -background orange
1787 label .vpane.lower.diff.header.l1 -text {File:} \
1788         -background orange \
1789         -font $font_ui
1790 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1791         -background orange \
1792         -anchor w \
1793         -justify left \
1794         -font $font_ui
1795 label .vpane.lower.diff.header.l3 -text {Status:} \
1796         -background orange \
1797         -font $font_ui
1798 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1799         -background orange \
1800         -width $max_status_desc \
1801         -anchor w \
1802         -justify left \
1803         -font $font_ui
1804 pack .vpane.lower.diff.header.l1 -side left
1805 pack .vpane.lower.diff.header.l2 -side left -fill x
1806 pack .vpane.lower.diff.header.l4 -side right
1807 pack .vpane.lower.diff.header.l3 -side right
1808
1809 # -- Diff Body
1810 frame .vpane.lower.diff.body
1811 set ui_diff .vpane.lower.diff.body.t
1812 text $ui_diff -background white -borderwidth 0 \
1813         -width 80 -height 15 -wrap none \
1814         -font $font_diff \
1815         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1816         -yscrollcommand {.vpane.lower.diff.body.sby set} \
1817         -cursor $maincursor \
1818         -state disabled
1819 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1820         -command [list $ui_diff xview]
1821 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1822         -command [list $ui_diff yview]
1823 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1824 pack .vpane.lower.diff.body.sby -side right -fill y
1825 pack $ui_diff -side left -fill both -expand 1
1826 pack .vpane.lower.diff.header -side top -fill x
1827 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1828
1829 $ui_diff tag conf dm -foreground red
1830 $ui_diff tag conf dp -foreground blue
1831 $ui_diff tag conf da -font [concat $font_diff bold]
1832 $ui_diff tag conf di -foreground "#00a000"
1833 $ui_diff tag conf dni -foreground "#a000a0"
1834 $ui_diff tag conf bold -font [concat $font_diff bold]
1835
1836 # -- Status Bar
1837 set ui_status_value {Initializing...}
1838 label .status -textvariable ui_status_value \
1839         -anchor w \
1840         -justify left \
1841         -borderwidth 1 \
1842         -relief sunken \
1843         -font $font_ui
1844 pack .status -anchor w -side bottom -fill x
1845
1846 # -- Load geometry
1847 catch {
1848 set gm [lindex $repo_config(gui.geometry) 0]
1849 wm geometry . [lindex $gm 0]
1850 .vpane sash place 0 \
1851         [lindex [.vpane sash coord 0] 0] \
1852         [lindex $gm 1]
1853 .vpane.files sash place 0 \
1854         [lindex $gm 2] \
1855         [lindex [.vpane.files sash coord 0] 1]
1856 unset gm
1857 }
1858
1859 # -- Key Bindings
1860 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1861 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
1862 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
1863 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
1864 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
1865 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
1866 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
1867 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
1868 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
1869 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1870 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1871
1872 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
1873 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
1874 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
1875 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
1876 bind $ui_diff <$M1B-Key-v> {break}
1877 bind $ui_diff <$M1B-Key-V> {break}
1878 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1879 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1880 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
1881 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
1882 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
1883 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
1884
1885 bind .   <Destroy> do_quit
1886 bind all <Key-F5> do_rescan
1887 bind all <$M1B-Key-r> do_rescan
1888 bind all <$M1B-Key-R> do_rescan
1889 bind .   <$M1B-Key-s> do_signoff
1890 bind .   <$M1B-Key-S> do_signoff
1891 bind .   <$M1B-Key-i> do_include_all
1892 bind .   <$M1B-Key-I> do_include_all
1893 bind .   <$M1B-Key-Return> do_commit
1894 bind all <$M1B-Key-q> do_quit
1895 bind all <$M1B-Key-Q> do_quit
1896 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1897 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1898 foreach i [list $ui_index $ui_other] {
1899         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1900         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1901         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1902 }
1903 unset i M1B M1T
1904
1905 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1906 focus -force $ui_comm
1907 load_all_remotes
1908 populate_remote_menu .mbar.fetch From fetch_from
1909 populate_remote_menu .mbar.push To push_to
1910 populate_pull_menu .mbar.pull
1911 update_status