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 ######################################################################
  11 ##
  12 ## task management
  13
  14 set single_commit 0
  15 set status_active 0
  16 set diff_active 0
  17 set checkin_active 0
  18 set commit_active 0
  19 set update_index_fd {}
  20
  21 set disable_on_lock [list]
  22 set index_lock_type none
  23
  24 proc lock_index {type} {
  25         global index_lock_type disable_on_lock
  26
  27         if {$index_lock_type == {none}} {
  28                 set index_lock_type $type
  29                 foreach w $disable_on_lock {
  30                         uplevel #0 $w disabled
  31                 }
  32                 return 1
  33         } elseif {$index_lock_type == {begin-update} && $type == {update}} {
  34                 set index_lock_type $type
  35                 return 1
  36         }
  37         return 0
  38 }
  39
  40 proc unlock_index {} {
  41         global index_lock_type disable_on_lock
  42
  43         set index_lock_type none
  44         foreach w $disable_on_lock {
  45                 uplevel #0 $w normal
  46         }
  47 }
  48
  49 ######################################################################
  50 ##
  51 ## status
  52
  53 proc repository_state {hdvar ctvar} {
  54         global gitdir
  55         upvar $hdvar hd $ctvar ct
  56
  57         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
  58                 set ct initial
  59         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
  60                 set ct merge
  61         } else {
  62                 set ct normal
  63         }
  64 }
  65
  66 proc update_status {} {
  67         global HEAD commit_type
  68         global ui_index ui_other ui_status_value ui_comm
  69         global status_active file_states
  70
  71         if {$status_active || ![lock_index read]} return
  72
  73         repository_state HEAD commit_type
  74         array unset file_states
  75         foreach w [list $ui_index $ui_other] {
  76                 $w conf -state normal
  77                 $w delete 0.0 end
  78                 $w conf -state disabled
  79         }
  80
  81         if {![$ui_comm edit modified]
  82             || [string trim [$ui_comm get 0.0 end]] == {}} {
  83                 if {[load_message GITGUI_MSG]} {
  84                 } elseif {[load_message MERGE_MSG]} {
  85                 } elseif {[load_message SQUASH_MSG]} {
  86                 }
  87                 $ui_comm edit modified false
  88         }
  89
  90         set status_active 1
  91         set ui_status_value {Refreshing file status...}
  92         set fd_rf [open "| git update-index -q --unmerged --refresh" r]
  93         fconfigure $fd_rf -blocking 0 -translation binary
  94         fileevent $fd_rf readable [list read_refresh $fd_rf]
  95 }
  96
  97 proc read_refresh {fd} {
  98         global gitdir HEAD commit_type
  99         global ui_index ui_other ui_status_value ui_comm
 100         global status_active file_states
 101
 102         read $fd
 103         if {![eof $fd]} return
 104         close $fd
 105
 106         set ls_others [list | git ls-files --others -z \
 107                 --exclude-per-directory=.gitignore]
 108         set info_exclude [file join $gitdir info exclude]
 109         if {[file readable $info_exclude]} {
 110                 lappend ls_others "--exclude-from=$info_exclude"
 111         }
 112
 113         set status_active 3
 114         set ui_status_value {Scanning for modified files ...}
 115         set fd_di [open "| git diff-index --cached -z $HEAD" r]
 116         set fd_df [open "| git diff-files -z" r]
 117         set fd_lo [open $ls_others r]
 118
 119         fconfigure $fd_di -blocking 0 -translation binary
 120         fconfigure $fd_df -blocking 0 -translation binary
 121         fconfigure $fd_lo -blocking 0 -translation binary
 122         fileevent $fd_di readable [list read_diff_index $fd_di]
 123         fileevent $fd_df readable [list read_diff_files $fd_df]
 124         fileevent $fd_lo readable [list read_ls_others $fd_lo]
 125 }
 126
 127 proc load_message {file} {
 128         global gitdir ui_comm
 129
 130         set f [file join $gitdir $file]
 131         if {[file exists $f]} {
 132                 if {[catch {set fd [open $f r]}]} {
 133                         return 0
 134                 }
 135                 set content [read $fd]
 136                 close $fd
 137                 $ui_comm delete 0.0 end
 138                 $ui_comm insert end $content
 139                 return 1
 140         }
 141         return 0
 142 }
 143
 144 proc read_diff_index {fd} {
 145         global buf_rdi
 146
 147         append buf_rdi [read $fd]
 148         set pck [split $buf_rdi "\0"]
 149         set buf_rdi [lindex $pck end]
 150         foreach {m p} [lrange $pck 0 end-1] {
 151                 if {$m != {} && $p != {}} {
 152                         display_file $p [string index $m end]_
 153                 }
 154         }
 155         status_eof $fd buf_rdi
 156 }
 157
 158 proc read_diff_files {fd} {
 159         global buf_rdf
 160
 161         append buf_rdf [read $fd]
 162         set pck [split $buf_rdf "\0"]
 163         set buf_rdf [lindex $pck end]
 164         foreach {m p} [lrange $pck 0 end-1] {
 165                 if {$m != {} && $p != {}} {
 166                         display_file $p _[string index $m end]
 167                 }
 168         }
 169         status_eof $fd buf_rdf
 170 }
 171
 172 proc read_ls_others {fd} {
 173         global buf_rlo
 174
 175         append buf_rlo [read $fd]
 176         set pck [split $buf_rlo "\0"]
 177         set buf_rlo [lindex $pck end]
 178         foreach p [lrange $pck 0 end-1] {
 179                 display_file $p _O
 180         }
 181         status_eof $fd buf_rlo
 182 }
 183
 184 proc status_eof {fd buf} {
 185         global status_active $buf
 186         global ui_fname_value ui_status_value
 187
 188         if {[eof $fd]} {
 189                 set $buf {}
 190                 close $fd
 191                 if {[incr status_active -1] == 0} {
 192                         unlock_index
 193                         set ui_status_value {Ready.}
 194                         if {$ui_fname_value != {}} {
 195                                 show_diff $ui_fname_value
 196                         }
 197                 }
 198         }
 199 }
 200
 201 ######################################################################
 202 ##
 203 ## diff
 204
 205 proc clear_diff {} {
 206         global ui_diff ui_fname_value ui_fstatus_value
 207
 208         $ui_diff conf -state normal
 209         $ui_diff delete 0.0 end
 210         $ui_diff conf -state disabled
 211         set ui_fname_value {}
 212         set ui_fstatus_value {}
 213 }
 214
 215 proc show_diff {path} {
 216         global file_states HEAD diff_3way diff_active
 217         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
 218
 219         if {$diff_active || ![lock_index read]} return
 220
 221         clear_diff
 222         set s $file_states($path)
 223         set m [lindex $s 0]
 224         set diff_3way 0
 225         set diff_active 1
 226         set ui_fname_value $path
 227         set ui_fstatus_value [mapdesc $m $path]
 228         set ui_status_value "Loading diff of $path..."
 229
 230         set cmd [list | git diff-index -p $HEAD -- $path]
 231         switch $m {
 232         AM {
 233         }
 234         MM {
 235                 set cmd [list | git diff-index -p -c $HEAD $path]
 236         }
 237         _O {
 238                 if {[catch {
 239                                 set fd [open $path r]
 240                                 set content [read $fd]
 241                                 close $fd
 242                         } err ]} {
 243                         set diff_active 0
 244                         unlock_index
 245                         set ui_status_value "Unable to display $path"
 246                         error_popup "Error loading file:\n$err"
 247                         return
 248                 }
 249                 $ui_diff conf -state normal
 250                 $ui_diff insert end $content
 251                 $ui_diff conf -state disabled
 252                 return
 253         }
 254         }
 255
 256         if {[catch {set fd [open $cmd r]} err]} {
 257                 set diff_active 0
 258                 unlock_index
 259                 set ui_status_value "Unable to display $path"
 260                 error_popup "Error loading diff:\n$err"
 261                 return
 262         }
 263
 264         fconfigure $fd -blocking 0 -translation auto
 265         fileevent $fd readable [list read_diff $fd]
 266 }
 267
 268 proc read_diff {fd} {
 269         global ui_diff ui_status_value diff_3way diff_active
 270
 271         while {[gets $fd line] >= 0} {
 272                 if {[string match {diff --git *} $line]} continue
 273                 if {[string match {diff --combined *} $line]} continue
 274                 if {[string match {--- *} $line]} continue
 275                 if {[string match {+++ *} $line]} continue
 276                 if {[string match index* $line]} {
 277                         if {[string first , $line] >= 0} {
 278                                 set diff_3way 1
 279                         }
 280                 }
 281
 282                 $ui_diff conf -state normal
 283                 if {!$diff_3way} {
 284                         set x [string index $line 0]
 285                         switch -- $x {
 286                         "@" {set tags da}
 287                         "+" {set tags dp}
 288                         "-" {set tags dm}
 289                         default {set tags {}}
 290                         }
 291                 } else {
 292                         set x [string range $line 0 1]
 293                         switch -- $x {
 294                         default {set tags {}}
 295                         "@@" {set tags da}
 296                         "++" {set tags dp; set x " +"}
 297                         " +" {set tags {di bold}; set x "++"}
 298                         "+ " {set tags dni; set x "-+"}
 299                         "--" {set tags dm; set x " -"}
 300                         " -" {set tags {dm bold}; set x "--"}
 301                         "- " {set tags di; set x "+-"}
 302                         default {set tags {}}
 303                         }
 304                         set line [string replace $line 0 1 $x]
 305                 }
 306                 $ui_diff insert end $line $tags
 307                 $ui_diff insert end "\n"
 308                 $ui_diff conf -state disabled
 309         }
 310
 311         if {[eof $fd]} {
 312                 close $fd
 313                 set diff_active 0
 314                 unlock_index
 315                 set ui_status_value {Ready.}
 316         }
 317 }
 318
 319 ######################################################################
 320 ##
 321 ## commit
 322
 323 proc commit_tree {} {
 324         global tcl_platform HEAD gitdir commit_type file_states
 325         global commit_active ui_status_value
 326         global ui_comm
 327
 328         if {$commit_active || ![lock_index update]} return
 329
 330         # -- Our in memory state should match the repository.
 331         #
 332         repository_state curHEAD cur_type
 333         if {$commit_type != $cur_type || $HEAD != $curHEAD} {
 334                 error_popup {Last scanned state does not match repository state.
 335
 336 Its highly likely that another Git program modified the
 337 repository since our last scan.  A rescan is required
 338 before committing.
 339 }
 340                 unlock_index
 341                 update_status
 342                 return
 343         }
 344
 345         # -- At least one file should differ in the index.
 346         #
 347         set files_ready 0
 348         foreach path [array names file_states] {
 349                 set s $file_states($path)
 350                 switch -glob -- [lindex $s 0] {
 351                 _* {continue}
 352                 A* -
 353                 D* -
 354                 M* {set files_ready 1; break}
 355                 U* {
 356                         error_popup "Unmerged files cannot be committed.
 357
 358 File $path has merge conflicts.
 359 You must resolve them and check the file in before committing.
 360 "
 361                         unlock_index
 362                         return
 363                 }
 364                 default {
 365                         error_popup "Unknown file state [lindex $s 0] detected.
 366
 367 File $path cannot be committed by this program.
 368 "
 369                 }
 370                 }
 371         }
 372         if {!$files_ready} {
 373                 error_popup {No checked-in files to commit.
 374
 375 You must check-in at least 1 file before you can commit.
 376 }
 377                 unlock_index
 378                 return
 379         }
 380
 381         # -- A message is required.
 382         #
 383         set msg [string trim [$ui_comm get 1.0 end]]
 384         if {$msg == {}} {
 385                 error_popup {Please supply a commit message.
 386
 387 A good commit message has the following format:
 388
 389 - First line: Describe in one sentance what you did.
 390 - Second line: Blank
 391 - Remaining lines: Describe why this change is good.
 392 }
 393                 unlock_index
 394                 return
 395         }
 396
 397         # -- Ask the pre-commit hook for the go-ahead.
 398         #
 399         set pchook [file join $gitdir hooks pre-commit]
 400         if {$tcl_platform(platform) == {windows} && [file exists $pchook]} {
 401                 set pchook [list sh -c \
 402                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
 403         } elseif {[file executable $pchook]} {
 404                 set pchook [list $pchook]
 405         } else {
 406                 set pchook {}
 407         }
 408         if {$pchook != {} && [catch {eval exec $pchook} err]} {
 409                 hook_failed_popup pre-commit $err
 410                 unlock_index
 411                 return
 412         }
 413
 414         # -- Write the tree in the background.
 415         #
 416         set commit_active 1
 417         set ui_status_value {Committing changes...}
 418
 419         set fd_wt [open "| git write-tree" r]
 420         fileevent $fd_wt readable \
 421                 [list commit_stage2 $fd_wt $curHEAD $msg]
 422 }
 423
 424 proc commit_stage2 {fd_wt curHEAD msg} {
 425         global single_commit gitdir HEAD commit_type
 426         global commit_active ui_status_value comm_ui
 427
 428         gets $fd_wt tree_id
 429         close $fd_wt
 430
 431         if {$tree_id == {}} {
 432                 error_popup "write-tree failed"
 433                 set commit_active 0
 434                 set ui_status_value {Commit failed.}
 435                 unlock_index
 436                 return
 437         }
 438
 439         # -- Create the commit.
 440         #
 441         set cmd [list git commit-tree $tree_id]
 442         if {$commit_type != {initial}} {
 443                 lappend cmd -p $HEAD
 444         }
 445         if {$commit_type == {merge}} {
 446                 if {[catch {
 447                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
 448                                 while {[gets $fd_mh merge_head] > 0} {
 449                                         lappend -p $merge_head
 450                                 }
 451                                 close $fd_mh
 452                         } err]} {
 453                         error_popup "Loading MERGE_HEADs failed:\n$err"
 454                         set commit_active 0
 455                         set ui_status_value {Commit failed.}
 456                         unlock_index
 457                         return
 458                 }
 459         }
 460         if {$commit_type == {initial}} {
 461                 # git commit-tree writes to stderr during initial commit.
 462                 lappend cmd 2>/dev/null
 463         }
 464         lappend cmd << $msg
 465         if {[catch {set cmt_id [eval exec $cmd]} err]} {
 466                 error_popup "commit-tree failed:\n$err"
 467                 set commit_active 0
 468                 set ui_status_value {Commit failed.}
 469                 unlock_index
 470                 return
 471         }
 472
 473         # -- Update the HEAD ref.
 474         #
 475         set reflogm commit
 476         if {$commit_type != {normal}} {
 477                 append reflogm " ($commit_type)"
 478         }
 479         set i [string first "\n" $msg]
 480         if {$i >= 0} {
 481                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
 482         } else {
 483                 append reflogm {: } $msg
 484         }
 485         set cmd [list git update-ref \
 486                 -m $reflogm \
 487                 HEAD $cmt_id $curHEAD]
 488         if {[catch {eval exec $cmd} err]} {
 489                 error_popup "update-ref failed:\n$err"
 490                 set commit_active 0
 491                 set ui_status_value {Commit failed.}
 492                 unlock_index
 493                 return
 494         }
 495
 496         # -- Cleanup after ourselves.
 497         #
 498         catch {file delete [file join $gitdir MERGE_HEAD]}
 499         catch {file delete [file join $gitdir MERGE_MSG]}
 500         catch {file delete [file join $gitdir SQUASH_MSG]}
 501         catch {file delete [file join $gitdir GITGUI_MSG]}
 502
 503         # -- Let rerere do its thing.
 504         #
 505         if {[file isdirectory [file join $gitdir rr-cache]]} {
 506                 catch {exec git rerere}
 507         }
 508
 509         $comm_ui delete 0.0 end
 510         $comm_ui edit modified false
 511
 512         if {$single_commit} do_quit
 513
 514         set commit_active 0
 515         set ui_status_value "Changes committed as $cmt_id."
 516         unlock_index
 517         update_status
 518 }
 519
 520 ######################################################################
 521 ##
 522 ## ui helpers
 523
 524 proc mapcol {state path} {
 525         global all_cols
 526
 527         if {[catch {set r $all_cols($state)}]} {
 528                 puts "error: no column for state={$state} $path"
 529                 return o
 530         }
 531         return $r
 532 }
 533
 534 proc mapicon {state path} {
 535         global all_icons
 536
 537         if {[catch {set r $all_icons($state)}]} {
 538                 puts "error: no icon for state={$state} $path"
 539                 return file_plain
 540         }
 541         return $r
 542 }
 543
 544 proc mapdesc {state path} {
 545         global all_descs
 546
 547         if {[catch {set r $all_descs($state)}]} {
 548                 puts "error: no desc for state={$state} $path"
 549                 return $state
 550         }
 551         return $r
 552 }
 553
 554 proc bsearch {w path} {
 555         set hi [expr [lindex [split [$w index end] .] 0] - 2]
 556         if {$hi == 0} {
 557                 return -1
 558         }
 559         set lo 0
 560         while {$lo < $hi} {
 561                 set mi [expr [expr $lo + $hi] / 2]
 562                 set ti [expr $mi + 1]
 563                 set cmp [string compare [$w get $ti.1 $ti.end] $path]
 564                 if {$cmp < 0} {
 565                         set lo $ti
 566                 } elseif {$cmp == 0} {
 567                         return $mi
 568                 } else {
 569                         set hi $mi
 570                 }
 571         }
 572         return -[expr $lo + 1]
 573 }
 574
 575 proc merge_state {path state} {
 576         global file_states
 577
 578         if {[array names file_states -exact $path] == {}}  {
 579                 set o __
 580                 set s [list $o none none]
 581         } else {
 582                 set s $file_states($path)
 583                 set o [lindex $s 0]
 584         }
 585
 586         set m [lindex $s 0]
 587         if {[string index $state 0] == "_"} {
 588                 set state [string index $m 0][string index $state 1]
 589         } elseif {[string index $state 0] == "*"} {
 590                 set state _[string index $state 1]
 591         }
 592
 593         if {[string index $state 1] == "_"} {
 594                 set state [string index $state 0][string index $m 1]
 595         } elseif {[string index $state 1] == "*"} {
 596                 set state [string index $state 0]_
 597         }
 598
 599         set file_states($path) [lreplace $s 0 0 $state]
 600         return $o
 601 }
 602
 603 proc display_file {path state} {
 604         global ui_index ui_other file_states
 605
 606         set old_m [merge_state $path $state]
 607         set s $file_states($path)
 608         set m [lindex $s 0]
 609
 610         if {[mapcol $m $path] == "o"} {
 611                 set ii 1
 612                 set ai 2
 613                 set iw $ui_index
 614                 set aw $ui_other
 615         } else {
 616                 set ii 2
 617                 set ai 1
 618                 set iw $ui_other
 619                 set aw $ui_index
 620         }
 621
 622         set d [lindex $s $ii]
 623         if {$d != "none"} {
 624                 set lno [bsearch $iw $path]
 625                 if {$lno >= 0} {
 626                         incr lno
 627                         $iw conf -state normal
 628                         $iw delete $lno.0 [expr $lno + 1].0
 629                         $iw conf -state disabled
 630                         set s [lreplace $s $ii $ii none]
 631                 }
 632         }
 633
 634         set d [lindex $s $ai]
 635         if {$d == "none"} {
 636                 set lno [expr abs([bsearch $aw $path] + 1) + 1]
 637                 $aw conf -state normal
 638                 set ico [$aw image create $lno.0 \
 639                         -align center -padx 5 -pady 1 \
 640                         -image [mapicon $m $path]]
 641                 $aw insert $lno.1 "$path\n"
 642                 $aw conf -state disabled
 643                 set file_states($path) [lreplace $s $ai $ai [list $ico]]
 644         } elseif {[mapicon $m $path] != [mapicon $old_m $path]} {
 645                 set ico [lindex $d 0]
 646                 $aw image conf $ico -image [mapicon $m $path]
 647         }
 648 }
 649
 650 proc with_update_index {body} {
 651         global update_index_fd
 652
 653         if {$update_index_fd == {}} {
 654                 if {![lock_index update]} return
 655                 set update_index_fd [open \
 656                         "| git update-index --add --remove -z --stdin" \
 657                         w]
 658                 fconfigure $update_index_fd -translation binary
 659                 uplevel 1 $body
 660                 close $update_index_fd
 661                 set update_index_fd {}
 662                 unlock_index
 663         } else {
 664                 uplevel 1 $body
 665         }
 666 }
 667
 668 proc update_index {path} {
 669         global update_index_fd
 670
 671         if {$update_index_fd == {}} {
 672                 error {not in with_update_index}
 673         } else {
 674                 puts -nonewline $update_index_fd "$path\0"
 675         }
 676 }
 677
 678 proc toggle_mode {path} {
 679         global file_states
 680
 681         set s $file_states($path)
 682         set m [lindex $s 0]
 683
 684         switch -- $m {
 685         AM -
 686         _O {set new A*}
 687         _M -
 688         MM {set new M*}
 689         _D {set new D*}
 690         default {return}
 691         }
 692
 693         with_update_index {update_index $path}
 694         display_file $path $new
 695 }
 696
 697 ######################################################################
 698 ##
 699 ## icons
 700
 701 set filemask {
 702 #define mask_width 14
 703 #define mask_height 15
 704 static unsigned char mask_bits[] = {
 705    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 706    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
 707    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
 708 }
 709
 710 image create bitmap file_plain -background white -foreground black -data {
 711 #define plain_width 14
 712 #define plain_height 15
 713 static unsigned char plain_bits[] = {
 714    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 715    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
 716    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 717 } -maskdata $filemask
 718
 719 image create bitmap file_mod -background white -foreground blue -data {
 720 #define mod_width 14
 721 #define mod_height 15
 722 static unsigned char mod_bits[] = {
 723    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 724    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 725    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 726 } -maskdata $filemask
 727
 728 image create bitmap file_fulltick -background white -foreground "#007000" -data {
 729 #define file_fulltick_width 14
 730 #define file_fulltick_height 15
 731 static unsigned char file_fulltick_bits[] = {
 732    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
 733    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
 734    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 735 } -maskdata $filemask
 736
 737 image create bitmap file_parttick -background white -foreground "#005050" -data {
 738 #define parttick_width 14
 739 #define parttick_height 15
 740 static unsigned char parttick_bits[] = {
 741    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
 742    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
 743    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 744 } -maskdata $filemask
 745
 746 image create bitmap file_question -background white -foreground black -data {
 747 #define file_question_width 14
 748 #define file_question_height 15
 749 static unsigned char file_question_bits[] = {
 750    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
 751    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
 752    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
 753 } -maskdata $filemask
 754
 755 image create bitmap file_removed -background white -foreground red -data {
 756 #define file_removed_width 14
 757 #define file_removed_height 15
 758 static unsigned char file_removed_bits[] = {
 759    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
 760    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
 761    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
 762 } -maskdata $filemask
 763
 764 image create bitmap file_merge -background white -foreground blue -data {
 765 #define file_merge_width 14
 766 #define file_merge_height 15
 767 static unsigned char file_merge_bits[] = {
 768    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
 769    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
 770    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
 771 } -maskdata $filemask
 772
 773 set max_status_desc 0
 774 foreach i {
 775                 {__ i plain    "Unmodified"}
 776                 {_M i mod      "Modified"}
 777                 {M_ i fulltick "Checked in"}
 778                 {MM i parttick "Partially checked in"}
 779
 780                 {_O o plain    "Untracked"}
 781                 {A_ o fulltick "Added"}
 782                 {AM o parttick "Partially added"}
 783
 784                 {_D i question "Missing"}
 785                 {D_ i removed  "Removed"}
 786                 {DD i removed  "Removed"}
 787                 {DO i removed  "Removed (still exists)"}
 788
 789                 {UM i merge    "Merge conflicts"}
 790                 {U_ i merge    "Merge conflicts"}
 791         } {
 792         if {$max_status_desc < [string length [lindex $i 3]]} {
 793                 set max_status_desc [string length [lindex $i 3]]
 794         }
 795         set all_cols([lindex $i 0]) [lindex $i 1]
 796         set all_icons([lindex $i 0]) file_[lindex $i 2]
 797         set all_descs([lindex $i 0]) [lindex $i 3]
 798 }
 799 unset filemask i
 800
 801 ######################################################################
 802 ##
 803 ## util
 804
 805 proc error_popup {msg} {
 806         set w .error
 807         toplevel $w
 808         wm transient $w .
 809         show_msg $w $w $msg
 810 }
 811
 812 proc show_msg {w top msg} {
 813         global gitdir appname
 814
 815         message $w.m -text $msg -justify left -aspect 400
 816         pack $w.m -side top -fill x -padx 5 -pady 10
 817         button $w.ok -text OK \
 818                 -width 15 \
 819                 -command "destroy $top"
 820         pack $w.ok -side bottom
 821         bind $top <Visibility> "grab $top; focus $top"
 822         bind $top <Key-Return> "destroy $top"
 823         wm title $top "error: $appname ([file normalize [file dirname $gitdir]])"
 824         tkwait window $top
 825 }
 826
 827 proc hook_failed_popup {hook msg} {
 828         global gitdir mainfont difffont appname
 829
 830         set w .hookfail
 831         toplevel $w
 832         wm transient $w .
 833
 834         frame $w.m
 835         label $w.m.l1 -text "$hook hook failed:" \
 836                 -anchor w \
 837                 -justify left \
 838                 -font [concat $mainfont bold]
 839         text $w.m.t \
 840                 -background white -borderwidth 1 \
 841                 -relief sunken \
 842                 -width 80 -height 10 \
 843                 -font $difffont \
 844                 -yscrollcommand [list $w.m.sby set]
 845         label $w.m.l2 \
 846                 -text {You must correct the above errors before committing.} \
 847                 -anchor w \
 848                 -justify left \
 849                 -font [concat $mainfont bold]
 850         scrollbar $w.m.sby -command [list $w.m.t yview]
 851         pack $w.m.l1 -side top -fill x
 852         pack $w.m.l2 -side bottom -fill x
 853         pack $w.m.sby -side right -fill y
 854         pack $w.m.t -side left -fill both -expand 1
 855         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
 856
 857         $w.m.t insert 1.0 $msg
 858         $w.m.t conf -state disabled
 859
 860         button $w.ok -text OK \
 861                 -width 15 \
 862                 -command "destroy $w"
 863         pack $w.ok -side bottom
 864
 865         bind $w <Visibility> "grab $w; focus $w"
 866         bind $w <Key-Return> "destroy $w"
 867         wm title $w "error: $appname ([file normalize [file dirname $gitdir]])"
 868         tkwait window $w
 869 }
 870
 871 ######################################################################
 872 ##
 873 ## ui commands
 874
 875 set starting_gitk_msg {Please wait... Starting gitk...}
 876 proc do_gitk {} {
 877         global tcl_platform ui_status_value starting_gitk_msg
 878
 879         set ui_status_value $starting_gitk_msg
 880         after 5000 {
 881                 if {$ui_status_value == $starting_gitk_msg} {
 882                         set ui_status_value {Ready.}
 883                 }
 884         }
 885
 886     if {$tcl_platform(platform) == "windows"} {
 887                 exec sh -c gitk &
 888         } else {
 889                 exec gitk &
 890         }
 891 }
 892
 893 proc do_quit {} {
 894         global gitdir ui_comm
 895
 896         set save [file join $gitdir GITGUI_MSG]
 897         set msg [string trim [$ui_comm get 0.0 end]]
 898         if {[$ui_comm edit modified] && $msg != {}} {
 899                 catch {
 900                         set fd [open $save w]
 901                         puts $fd [string trim [$ui_comm get 0.0 end]]
 902                         close $fd
 903                 }
 904         } elseif {$msg == {} && [file exists $save]} {
 905                 file delete $save
 906         }
 907
 908         destroy .
 909 }
 910
 911 proc do_rescan {} {
 912         update_status
 913 }
 914
 915 proc do_checkin_all {} {
 916         global checkin_active ui_status_value
 917
 918         if {$checkin_active || ![lock_index begin-update]} return
 919
 920         set checkin_active 1
 921         set ui_status_value {Checking in all files...}
 922         after 1 {
 923                 with_update_index {
 924                         foreach path [array names file_states] {
 925                                 set s $file_states($path)
 926                                 set m [lindex $s 0]
 927                                 switch -- $m {
 928                                 AM -
 929                                 MM -
 930                                 _M -
 931                                 _D {toggle_mode $path}
 932                                 }
 933                         }
 934                 }
 935                 set checkin_active 0
 936                 set ui_status_value {Ready.}
 937         }
 938 }
 939
 940 proc do_signoff {} {
 941         global ui_comm
 942
 943         catch {
 944                 set me [exec git var GIT_COMMITTER_IDENT]
 945                 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
 946                         set str "Signed-off-by: $name"
 947                         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
 948                                 $ui_comm insert end "\n"
 949                                 $ui_comm insert end $str
 950                                 $ui_comm see end
 951                         }
 952                 }
 953         }
 954 }
 955
 956 proc do_commit {} {
 957         commit_tree
 958 }
 959
 960 # shift == 1: left click
 961 #          3: right click
 962 proc click {w x y shift wx wy} {
 963         global ui_index ui_other
 964
 965         set pos [split [$w index @$x,$y] .]
 966         set lno [lindex $pos 0]
 967         set col [lindex $pos 1]
 968         set path [$w get $lno.1 $lno.end]
 969         if {$path == {}} return
 970
 971         if {$col > 0 && $shift == 1} {
 972                 $ui_index tag remove in_diff 0.0 end
 973                 $ui_other tag remove in_diff 0.0 end
 974                 $w tag add in_diff $lno.0 [expr $lno + 1].0
 975                 show_diff $path
 976         }
 977 }
 978
 979 proc unclick {w x y} {
 980         set pos [split [$w index @$x,$y] .]
 981         set lno [lindex $pos 0]
 982         set col [lindex $pos 1]
 983         set path [$w get $lno.1 $lno.end]
 984         if {$path == {}} return
 985
 986         if {$col == 0} {
 987                 toggle_mode $path
 988         }
 989 }
 990
 991 ######################################################################
 992 ##
 993 ## ui init
 994
 995 set mainfont {Helvetica 10}
 996 set difffont {Courier 10}
 997 set maincursor [. cget -cursor]
 998
 999 switch -- $tcl_platform(platform) {
1000 windows {set M1B Control; set M1T Ctrl}
1001 default {set M1B M1; set M1T M1}
1002 }
1003
1004 # -- Menu Bar
1005 menu .mbar -tearoff 0
1006 .mbar add cascade -label Project -menu .mbar.project
1007 .mbar add cascade -label Commit -menu .mbar.commit
1008 .mbar add cascade -label Fetch -menu .mbar.fetch
1009 .mbar add cascade -label Pull -menu .mbar.pull
1010 . configure -menu .mbar
1011
1012 # -- Project Menu
1013 menu .mbar.project
1014 .mbar.project add command -label Visualize \
1015         -command do_gitk \
1016         -font $mainfont
1017 .mbar.project add command -label Quit \
1018         -command do_quit \
1019         -accelerator $M1T-Q \
1020         -font $mainfont
1021
1022 # -- Commit Menu
1023 menu .mbar.commit
1024 .mbar.commit add command -label Rescan \
1025         -command do_rescan \
1026         -accelerator F5 \
1027         -font $mainfont
1028 lappend disable_on_lock \
1029         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1030 .mbar.commit add command -label {Check-in All Files} \
1031         -command do_checkin_all \
1032         -accelerator $M1T-U \
1033         -font $mainfont
1034 lappend disable_on_lock \
1035         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1036 .mbar.commit add command -label {Sign Off} \
1037         -command do_signoff \
1038         -accelerator $M1T-S \
1039         -font $mainfont
1040 .mbar.commit add command -label Commit \
1041         -command do_commit \
1042         -accelerator $M1T-Return \
1043         -font $mainfont
1044 lappend disable_on_lock \
1045         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1046
1047 # -- Fetch Menu
1048 menu .mbar.fetch
1049
1050 # -- Pull Menu
1051 menu .mbar.pull
1052
1053 # -- Main Window Layout
1054 panedwindow .vpane -orient vertical
1055 panedwindow .vpane.files -orient horizontal
1056 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1057 pack .vpane -anchor n -side top -fill both -expand 1
1058
1059 # -- Index File List
1060 set ui_index .vpane.files.index.list
1061 frame .vpane.files.index -height 100 -width 400
1062 label .vpane.files.index.title -text {Modified Files} \
1063         -background green \
1064         -font $mainfont
1065 text $ui_index -background white -borderwidth 0 \
1066         -width 40 -height 10 \
1067         -font $mainfont \
1068         -yscrollcommand {.vpane.files.index.sb set} \
1069         -cursor $maincursor \
1070         -state disabled
1071 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1072 pack .vpane.files.index.title -side top -fill x
1073 pack .vpane.files.index.sb -side right -fill y
1074 pack $ui_index -side left -fill both -expand 1
1075 .vpane.files add .vpane.files.index -sticky nsew
1076
1077 # -- Other (Add) File List
1078 set ui_other .vpane.files.other.list
1079 frame .vpane.files.other -height 100 -width 100
1080 label .vpane.files.other.title -text {Untracked Files} \
1081         -background red \
1082         -font $mainfont
1083 text $ui_other -background white -borderwidth 0 \
1084         -width 40 -height 10 \
1085         -font $mainfont \
1086         -yscrollcommand {.vpane.files.other.sb set} \
1087         -cursor $maincursor \
1088         -state disabled
1089 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1090 pack .vpane.files.other.title -side top -fill x
1091 pack .vpane.files.other.sb -side right -fill y
1092 pack $ui_other -side left -fill both -expand 1
1093 .vpane.files add .vpane.files.other -sticky nsew
1094
1095 $ui_index tag conf in_diff -font [concat $mainfont bold]
1096 $ui_other tag conf in_diff -font [concat $mainfont bold]
1097
1098 # -- Diff Header
1099 set ui_fname_value {}
1100 set ui_fstatus_value {}
1101 frame .vpane.diff -height 200 -width 400
1102 frame .vpane.diff.header
1103 label .vpane.diff.header.l1 -text {File:} -font $mainfont
1104 label .vpane.diff.header.l2 -textvariable ui_fname_value \
1105         -anchor w \
1106         -justify left \
1107         -font $mainfont
1108 label .vpane.diff.header.l3 -text {Status:} -font $mainfont
1109 label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
1110         -width $max_status_desc \
1111         -anchor w \
1112         -justify left \
1113         -font $mainfont
1114 pack .vpane.diff.header.l1 -side left
1115 pack .vpane.diff.header.l2 -side left -fill x
1116 pack .vpane.diff.header.l4 -side right
1117 pack .vpane.diff.header.l3 -side right
1118
1119 # -- Diff Body
1120 frame .vpane.diff.body
1121 set ui_diff .vpane.diff.body.t
1122 text $ui_diff -background white -borderwidth 0 \
1123         -width 80 -height 15 -wrap none \
1124         -font $difffont \
1125         -xscrollcommand {.vpane.diff.body.sbx set} \
1126         -yscrollcommand {.vpane.diff.body.sby set} \
1127         -cursor $maincursor \
1128         -state disabled
1129 scrollbar .vpane.diff.body.sbx -orient horizontal \
1130         -command [list $ui_diff xview]
1131 scrollbar .vpane.diff.body.sby -orient vertical \
1132         -command [list $ui_diff yview]
1133 pack .vpane.diff.body.sbx -side bottom -fill x
1134 pack .vpane.diff.body.sby -side right -fill y
1135 pack $ui_diff -side left -fill both -expand 1
1136 pack .vpane.diff.header -side top -fill x
1137 pack .vpane.diff.body -side bottom -fill both -expand 1
1138 .vpane add .vpane.diff -stick nsew
1139
1140 $ui_diff tag conf dm -foreground red
1141 $ui_diff tag conf dp -foreground blue
1142 $ui_diff tag conf da -font [concat $difffont bold]
1143 $ui_diff tag conf di -foreground "#00a000"
1144 $ui_diff tag conf dni -foreground "#a000a0"
1145 $ui_diff tag conf bold -font [concat $difffont bold]
1146
1147 # -- Commit Area
1148 frame .vpane.commarea -height 150
1149 .vpane add .vpane.commarea -stick nsew
1150
1151 # -- Commit Area Buttons
1152 frame .vpane.commarea.buttons
1153 label .vpane.commarea.buttons.l -text {} \
1154         -anchor w \
1155         -justify left \
1156         -font $mainfont
1157 pack .vpane.commarea.buttons.l -side top -fill x
1158 pack .vpane.commarea.buttons -side left -fill y
1159
1160 button .vpane.commarea.buttons.rescan -text {Rescan} \
1161         -command do_rescan \
1162         -font $mainfont
1163 pack .vpane.commarea.buttons.rescan -side top -fill x
1164 lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1165
1166 button .vpane.commarea.buttons.ciall -text {Check-in All} \
1167         -command do_checkin_all \
1168         -font $mainfont
1169 pack .vpane.commarea.buttons.ciall -side top -fill x
1170 lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1171
1172 button .vpane.commarea.buttons.signoff -text {Sign Off} \
1173         -command do_signoff \
1174         -font $mainfont
1175 pack .vpane.commarea.buttons.signoff -side top -fill x
1176
1177 button .vpane.commarea.buttons.commit -text {Commit} \
1178         -command do_commit \
1179         -font $mainfont
1180 pack .vpane.commarea.buttons.commit -side top -fill x
1181 lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1182
1183 # -- Commit Message Buffer
1184 frame .vpane.commarea.buffer
1185 set ui_comm .vpane.commarea.buffer.t
1186 label .vpane.commarea.buffer.l -text {Commit Message:} \
1187         -anchor w \
1188         -justify left \
1189         -font $mainfont
1190 text $ui_comm -background white -borderwidth 1 \
1191         -relief sunken \
1192         -width 75 -height 10 -wrap none \
1193         -font $difffont \
1194         -yscrollcommand {.vpane.commarea.buffer.sby set} \
1195         -cursor $maincursor
1196 scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1197 pack .vpane.commarea.buffer.l -side top -fill x
1198 pack .vpane.commarea.buffer.sby -side right -fill y
1199 pack $ui_comm -side left -fill y
1200 pack .vpane.commarea.buffer -side left -fill y
1201
1202 # -- Status Bar
1203 set ui_status_value {Initializing...}
1204 label .status -textvariable ui_status_value \
1205         -anchor w \
1206         -justify left \
1207         -borderwidth 1 \
1208         -relief sunken \
1209         -font $mainfont
1210 pack .status -anchor w -side bottom -fill x
1211
1212 # -- Key Bindings
1213 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1214 bind . <Destroy> do_quit
1215 bind . <Key-F5> do_rescan
1216 bind . <$M1B-Key-r> do_rescan
1217 bind . <$M1B-Key-R> do_rescan
1218 bind . <$M1B-Key-s> do_signoff
1219 bind . <$M1B-Key-S> do_signoff
1220 bind . <$M1B-Key-u> do_checkin_all
1221 bind . <$M1B-Key-U> do_checkin_all
1222 bind . <$M1B-Key-Return> do_commit
1223 bind . <$M1B-Key-q> do_quit
1224 bind . <$M1B-Key-Q> do_quit
1225 foreach i [list $ui_index $ui_other] {
1226         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1227         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1228         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1229 }
1230 unset i M1B M1T
1231
1232 ######################################################################
1233 ##
1234 ## main
1235
1236 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1237         show_msg {} . "Cannot find the git directory: $err"
1238         exit 1
1239 }
1240
1241 set appname [lindex [file split $argv0] end]
1242 if {$appname == {git-citool}} {
1243         set single_commit 1
1244 }
1245
1246 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1247 focus -force $ui_comm
1248 update_status