git-guion commit git-gui: Finished commit implementation. (ec6b424)
   1#!/bin/sh
   2# Tcl ignores the next line -*- tcl -*- \
   3exec 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
  14set single_commit 0
  15set status_active 0
  16set diff_active 0
  17set checkin_active 0
  18set commit_active 0
  19set update_index_fd {}
  20
  21set disable_on_lock [list]
  22set index_lock_type none
  23
  24proc 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
  40proc 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
  53proc 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
  66proc 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
  97proc 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
 127proc 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
 144proc 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
 158proc 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
 172proc 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
 184proc 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
 205proc 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
 215proc 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
 268proc 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
 323proc 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
 336Its highly likely that another Git program modified the
 337repository since our last scan.  A rescan is required
 338before 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
 358File $path has merge conflicts.
 359You 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
 367File $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
 375You 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
 387A 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
 424proc 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
 524proc 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
 534proc 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
 544proc 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
 554proc 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
 575proc 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
 603proc 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
 650proc 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
 668proc 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
 678proc 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
 701set filemask {
 702#define mask_width 14
 703#define mask_height 15
 704static 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
 710image create bitmap file_plain -background white -foreground black -data {
 711#define plain_width 14
 712#define plain_height 15
 713static 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
 719image create bitmap file_mod -background white -foreground blue -data {
 720#define mod_width 14
 721#define mod_height 15
 722static 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
 728image create bitmap file_fulltick -background white -foreground "#007000" -data {
 729#define file_fulltick_width 14
 730#define file_fulltick_height 15
 731static 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
 737image create bitmap file_parttick -background white -foreground "#005050" -data {
 738#define parttick_width 14
 739#define parttick_height 15
 740static 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
 746image create bitmap file_question -background white -foreground black -data {
 747#define file_question_width 14
 748#define file_question_height 15
 749static 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
 755image create bitmap file_removed -background white -foreground red -data {
 756#define file_removed_width 14
 757#define file_removed_height 15
 758static 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
 764image create bitmap file_merge -background white -foreground blue -data {
 765#define file_merge_width 14
 766#define file_merge_height 15
 767static 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
 773set max_status_desc 0
 774foreach 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}
 799unset filemask i
 800
 801######################################################################
 802##
 803## util
 804
 805proc error_popup {msg} {
 806        set w .error
 807        toplevel $w
 808        wm transient $w .
 809        show_msg $w $w $msg
 810}
 811
 812proc 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
 827proc 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
 875set starting_gitk_msg {Please wait... Starting gitk...}
 876proc 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
 893proc 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
 911proc do_rescan {} {
 912        update_status
 913}
 914
 915proc 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
 940proc 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
 956proc do_commit {} {
 957        commit_tree
 958}
 959
 960# shift == 1: left click
 961#          3: right click  
 962proc 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
 979proc 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
 995set mainfont {Helvetica 10}
 996set difffont {Courier 10}
 997set maincursor [. cget -cursor]
 998
 999switch -- $tcl_platform(platform) {
1000windows {set M1B Control; set M1T Ctrl}
1001default {set M1B M1; set M1T M1}
1002}
1003
1004# -- Menu Bar
1005menu .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
1013menu .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
1023menu .mbar.commit
1024.mbar.commit add command -label Rescan \
1025        -command do_rescan \
1026        -accelerator F5 \
1027        -font $mainfont
1028lappend 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
1034lappend 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
1044lappend disable_on_lock \
1045        [list .mbar.commit entryconf [.mbar.commit index last] -state]
1046
1047# -- Fetch Menu
1048menu .mbar.fetch
1049
1050# -- Pull Menu
1051menu .mbar.pull
1052
1053# -- Main Window Layout
1054panedwindow .vpane -orient vertical
1055panedwindow .vpane.files -orient horizontal
1056.vpane add .vpane.files -sticky nsew -height 100 -width 400
1057pack .vpane -anchor n -side top -fill both -expand 1
1058
1059# -- Index File List
1060set ui_index .vpane.files.index.list
1061frame .vpane.files.index -height 100 -width 400
1062label .vpane.files.index.title -text {Modified Files} \
1063        -background green \
1064        -font $mainfont
1065text $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
1071scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1072pack .vpane.files.index.title -side top -fill x
1073pack .vpane.files.index.sb -side right -fill y
1074pack $ui_index -side left -fill both -expand 1
1075.vpane.files add .vpane.files.index -sticky nsew
1076
1077# -- Other (Add) File List
1078set ui_other .vpane.files.other.list
1079frame .vpane.files.other -height 100 -width 100
1080label .vpane.files.other.title -text {Untracked Files} \
1081        -background red \
1082        -font $mainfont
1083text $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
1089scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1090pack .vpane.files.other.title -side top -fill x
1091pack .vpane.files.other.sb -side right -fill y
1092pack $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
1099set ui_fname_value {}
1100set ui_fstatus_value {}
1101frame .vpane.diff -height 200 -width 400
1102frame .vpane.diff.header
1103label .vpane.diff.header.l1 -text {File:} -font $mainfont
1104label .vpane.diff.header.l2 -textvariable ui_fname_value \
1105        -anchor w \
1106        -justify left \
1107        -font $mainfont
1108label .vpane.diff.header.l3 -text {Status:} -font $mainfont
1109label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
1110        -width $max_status_desc \
1111        -anchor w \
1112        -justify left \
1113        -font $mainfont
1114pack .vpane.diff.header.l1 -side left
1115pack .vpane.diff.header.l2 -side left -fill x
1116pack .vpane.diff.header.l4 -side right
1117pack .vpane.diff.header.l3 -side right
1118
1119# -- Diff Body
1120frame .vpane.diff.body
1121set ui_diff .vpane.diff.body.t
1122text $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
1129scrollbar .vpane.diff.body.sbx -orient horizontal \
1130        -command [list $ui_diff xview]
1131scrollbar .vpane.diff.body.sby -orient vertical \
1132        -command [list $ui_diff yview]
1133pack .vpane.diff.body.sbx -side bottom -fill x
1134pack .vpane.diff.body.sby -side right -fill y
1135pack $ui_diff -side left -fill both -expand 1
1136pack .vpane.diff.header -side top -fill x
1137pack .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
1148frame .vpane.commarea -height 150
1149.vpane add .vpane.commarea -stick nsew
1150
1151# -- Commit Area Buttons
1152frame .vpane.commarea.buttons
1153label .vpane.commarea.buttons.l -text {} \
1154        -anchor w \
1155        -justify left \
1156        -font $mainfont
1157pack .vpane.commarea.buttons.l -side top -fill x
1158pack .vpane.commarea.buttons -side left -fill y
1159
1160button .vpane.commarea.buttons.rescan -text {Rescan} \
1161        -command do_rescan \
1162        -font $mainfont
1163pack .vpane.commarea.buttons.rescan -side top -fill x
1164lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1165
1166button .vpane.commarea.buttons.ciall -text {Check-in All} \
1167        -command do_checkin_all \
1168        -font $mainfont
1169pack .vpane.commarea.buttons.ciall -side top -fill x
1170lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1171
1172button .vpane.commarea.buttons.signoff -text {Sign Off} \
1173        -command do_signoff \
1174        -font $mainfont
1175pack .vpane.commarea.buttons.signoff -side top -fill x
1176
1177button .vpane.commarea.buttons.commit -text {Commit} \
1178        -command do_commit \
1179        -font $mainfont
1180pack .vpane.commarea.buttons.commit -side top -fill x
1181lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1182
1183# -- Commit Message Buffer
1184frame .vpane.commarea.buffer
1185set ui_comm .vpane.commarea.buffer.t
1186label .vpane.commarea.buffer.l -text {Commit Message:} \
1187        -anchor w \
1188        -justify left \
1189        -font $mainfont
1190text $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
1196scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1197pack .vpane.commarea.buffer.l -side top -fill x
1198pack .vpane.commarea.buffer.sby -side right -fill y
1199pack $ui_comm -side left -fill y
1200pack .vpane.commarea.buffer -side left -fill y
1201
1202# -- Status Bar
1203set ui_status_value {Initializing...}
1204label .status -textvariable ui_status_value \
1205        -anchor w \
1206        -justify left \
1207        -borderwidth 1 \
1208        -relief sunken \
1209        -font $mainfont
1210pack .status -anchor w -side bottom -fill x
1211
1212# -- Key Bindings
1213bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1214bind . <Destroy> do_quit
1215bind . <Key-F5> do_rescan
1216bind . <$M1B-Key-r> do_rescan
1217bind . <$M1B-Key-R> do_rescan
1218bind . <$M1B-Key-s> do_signoff
1219bind . <$M1B-Key-S> do_signoff
1220bind . <$M1B-Key-u> do_checkin_all
1221bind . <$M1B-Key-U> do_checkin_all
1222bind . <$M1B-Key-Return> do_commit
1223bind . <$M1B-Key-q> do_quit
1224bind . <$M1B-Key-Q> do_quit
1225foreach 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}
1230unset i M1B M1T
1231
1232######################################################################
1233##
1234## main
1235
1236if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1237        show_msg {} . "Cannot find the git directory: $err"
1238        exit 1
1239}
1240
1241set appname [lindex [file split $argv0] end]
1242if {$appname == {git-citool}} {
1243        set single_commit 1
1244}
1245
1246wm title . "$appname ([file normalize [file dirname $gitdir]])"
1247focus -force $ui_comm
1248update_status