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