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 status_active 0
  15 set diff_active 0
  16 set checkin_active 0
  17 set update_index_fd {}
  18
  19 set disable_on_lock [list]
  20 set index_lock_type none
  21
  22 proc 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
  38 proc 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
  51 proc 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
  87 proc 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
 117 proc 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
 134 proc 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
 148 proc 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
 162 proc 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
 174 proc 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
 195 proc 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
 205 proc 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
 258 proc 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
 313 proc 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
 323 proc 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
 333 proc 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
 343 proc 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
 364 proc 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
 392 proc 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
 439 proc 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
 457 proc 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
 467 proc 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
 490 set filemask {
 491 #define mask_width 14
 492 #define mask_height 15
 493 static 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
 499 image create bitmap file_plain -background white -foreground black -data {
 500 #define plain_width 14
 501 #define plain_height 15
 502 static 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
 508 image create bitmap file_mod -background white -foreground blue -data {
 509 #define mod_width 14
 510 #define mod_height 15
 511 static 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
 517 image create bitmap file_fulltick -background white -foreground "#007000" -data {
 518 #define file_fulltick_width 14
 519 #define file_fulltick_height 15
 520 static 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
 526 image create bitmap file_parttick -background white -foreground "#005050" -data {
 527 #define parttick_width 14
 528 #define parttick_height 15
 529 static 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
 535 image create bitmap file_question -background white -foreground black -data {
 536 #define file_question_width 14
 537 #define file_question_height 15
 538 static 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
 544 image create bitmap file_removed -background white -foreground red -data {
 545 #define file_removed_width 14
 546 #define file_removed_height 15
 547 static 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
 553 image create bitmap file_merge -background white -foreground blue -data {
 554 #define file_merge_width 14
 555 #define file_merge_height 15
 556 static 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
 562 set max_status_desc 0
 563 foreach 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 }
 588 unset filemask i
 589
 590 ######################################################################
 591 ##
 592 ## util
 593
 594 proc error_popup {msg} {
 595         set w .error
 596         toplevel $w
 597         wm transient $w .
 598         show_msg $w $w $msg
 599 }
 600
 601 proc 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
 614 proc 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
 662 set starting_gitk_msg {Please wait... Starting gitk...}
 663 proc 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
 680 proc 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
 698 proc do_rescan {} {
 699         update_status
 700 }
 701
 702 proc 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
 727 proc 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
 743 proc 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
 757 Its highly likely that another Git program modified the
 758 repository since our last scan.  A rescan is required
 759 before 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
 778 File $path has merge conflicts.
 779 You 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
 786 File $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
 794 You 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
 805 A 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
 833 proc 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
 850 proc 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
 866 set mainfont {Helvetica 10}
 867 set difffont {Courier 10}
 868 set maincursor [. cget -cursor]
 869
 870 switch -- $tcl_platform(platform) {
 871 windows {set M1B Control; set M1T Ctrl}
 872 default {set M1B M1; set M1T M1}
 873 }
 874
 875 # -- Menu Bar
 876 menu .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
 884 menu .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
 894 menu .mbar.commit
 895 .mbar.commit add command -label Rescan \
 896         -command do_rescan \
 897         -accelerator F5 \
 898         -font $mainfont
 899 lappend 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
 905 lappend 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
 915 lappend disable_on_lock \
 916         [list .mbar.commit entryconf [.mbar.commit index last] -state]
 917
 918 # -- Fetch Menu
 919 menu .mbar.fetch
 920
 921 # -- Pull Menu
 922 menu .mbar.pull
 923
 924 # -- Main Window Layout
 925 panedwindow .vpane -orient vertical
 926 panedwindow .vpane.files -orient horizontal
 927 .vpane add .vpane.files -sticky nsew -height 100 -width 400
 928 pack .vpane -anchor n -side top -fill both -expand 1
 929
 930 # -- Index File List
 931 set ui_index .vpane.files.index.list
 932 frame .vpane.files.index -height 100 -width 400
 933 label .vpane.files.index.title -text {Modified Files} \
 934         -background green \
 935         -font $mainfont
 936 text $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
 942 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
 943 pack .vpane.files.index.title -side top -fill x
 944 pack .vpane.files.index.sb -side right -fill y
 945 pack $ui_index -side left -fill both -expand 1
 946 .vpane.files add .vpane.files.index -sticky nsew
 947
 948 # -- Other (Add) File List
 949 set ui_other .vpane.files.other.list
 950 frame .vpane.files.other -height 100 -width 100
 951 label .vpane.files.other.title -text {Untracked Files} \
 952         -background red \
 953         -font $mainfont
 954 text $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
 960 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
 961 pack .vpane.files.other.title -side top -fill x
 962 pack .vpane.files.other.sb -side right -fill y
 963 pack $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
 970 set ui_fname_value {}
 971 set ui_fstatus_value {}
 972 frame .vpane.diff -height 200 -width 400
 973 frame .vpane.diff.header
 974 label .vpane.diff.header.l1 -text {File:} -font $mainfont
 975 label .vpane.diff.header.l2 -textvariable ui_fname_value \
 976         -anchor w \
 977         -justify left \
 978         -font $mainfont
 979 label .vpane.diff.header.l3 -text {Status:} -font $mainfont
 980 label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
 981         -width $max_status_desc \
 982         -anchor w \
 983         -justify left \
 984         -font $mainfont
 985 pack .vpane.diff.header.l1 -side left
 986 pack .vpane.diff.header.l2 -side left -fill x
 987 pack .vpane.diff.header.l4 -side right
 988 pack .vpane.diff.header.l3 -side right
 989
 990 # -- Diff Body
 991 frame .vpane.diff.body
 992 set ui_diff .vpane.diff.body.t
 993 text $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
1000 scrollbar .vpane.diff.body.sbx -orient horizontal \
1001         -command [list $ui_diff xview]
1002 scrollbar .vpane.diff.body.sby -orient vertical \
1003         -command [list $ui_diff yview]
1004 pack .vpane.diff.body.sbx -side bottom -fill x
1005 pack .vpane.diff.body.sby -side right -fill y
1006 pack $ui_diff -side left -fill both -expand 1
1007 pack .vpane.diff.header -side top -fill x
1008 pack .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
1019 frame .vpane.commarea -height 150
1020 .vpane add .vpane.commarea -stick nsew
1021
1022 # -- Commit Area Buttons
1023 frame .vpane.commarea.buttons
1024 label .vpane.commarea.buttons.l -text {} \
1025         -anchor w \
1026         -justify left \
1027         -font $mainfont
1028 pack .vpane.commarea.buttons.l -side top -fill x
1029 pack .vpane.commarea.buttons -side left -fill y
1030
1031 button .vpane.commarea.buttons.rescan -text {Rescan} \
1032         -command do_rescan \
1033         -font $mainfont
1034 pack .vpane.commarea.buttons.rescan -side top -fill x
1035 lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1036
1037 button .vpane.commarea.buttons.ciall -text {Check-in All} \
1038         -command do_checkin_all \
1039         -font $mainfont
1040 pack .vpane.commarea.buttons.ciall -side top -fill x
1041 lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1042
1043 button .vpane.commarea.buttons.signoff -text {Sign Off} \
1044         -command do_signoff \
1045         -font $mainfont
1046 pack .vpane.commarea.buttons.signoff -side top -fill x
1047
1048 button .vpane.commarea.buttons.commit -text {Commit} \
1049         -command do_commit \
1050         -font $mainfont
1051 pack .vpane.commarea.buttons.commit -side top -fill x
1052 lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1053
1054 # -- Commit Message Buffer
1055 frame .vpane.commarea.buffer
1056 set ui_comm .vpane.commarea.buffer.t
1057 label .vpane.commarea.buffer.l -text {Commit Message:} \
1058         -anchor w \
1059         -justify left \
1060         -font $mainfont
1061 text $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
1067 scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1068 pack .vpane.commarea.buffer.l -side top -fill x
1069 pack .vpane.commarea.buffer.sby -side right -fill y
1070 pack $ui_comm -side left -fill y
1071 pack .vpane.commarea.buffer -side left -fill y
1072
1073 # -- Status Bar
1074 set ui_status_value {Initializing...}
1075 label .status -textvariable ui_status_value \
1076         -anchor w \
1077         -justify left \
1078         -borderwidth 1 \
1079         -relief sunken \
1080         -font $mainfont
1081 pack .status -anchor w -side bottom -fill x
1082
1083 # -- Key Bindings
1084 bind . <Destroy> do_quit
1085 bind . <Key-F5> do_rescan
1086 bind . <$M1B-Key-r> do_rescan
1087 bind . <$M1B-Key-R> do_rescan
1088 bind . <$M1B-Key-s> do_signoff
1089 bind . <$M1B-Key-S> do_signoff
1090 bind . <$M1B-Key-u> do_checkin_all
1091 bind . <$M1B-Key-U> do_checkin_all
1092 bind . <$M1B-Key-Return> do_commit
1093 bind . <$M1B-Key-q> do_quit
1094 bind . <$M1B-Key-Q> do_quit
1095 foreach 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 }
1100 unset i M1B M1T
1101
1102 ######################################################################
1103 ##
1104 ## main
1105
1106 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1107         show_msg {} . "Cannot find the git directory: $err"
1108         exit 1
1109 }
1110
1111 wm title . "git-ui ([file normalize [file dirname $gitdir]])"
1112 focus -force $ui_comm
1113 update_status