git-gui: Worked around environment variable problems on Windows.
[git-gui.git] / git-gui
blobbe361dec171827afd2464012fb257e10e10cb544
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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.
10 ######################################################################
12 ## task management
14 set single_commit 0
15 set status_active 0
16 set diff_active 0
17 set checkin_active 0
18 set commit_active 0
19 set update_index_fd {}
21 set disable_on_lock [list]
22 set index_lock_type none
24 set HEAD {}
25 set PARENT {}
26 set commit_type {}
28 proc lock_index {type} {
29 global index_lock_type disable_on_lock
31 if {$index_lock_type == {none}} {
32 set index_lock_type $type
33 foreach w $disable_on_lock {
34 uplevel #0 $w disabled
36 return 1
37 } elseif {$index_lock_type == {begin-update} && $type == {update}} {
38 set index_lock_type $type
39 return 1
41 return 0
44 proc unlock_index {} {
45 global index_lock_type disable_on_lock
47 set index_lock_type none
48 foreach w $disable_on_lock {
49 uplevel #0 $w normal
53 ######################################################################
55 ## status
57 proc repository_state {hdvar ctvar} {
58 global gitdir
59 upvar $hdvar hd $ctvar ct
61 if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
62 set ct initial
63 } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
64 set ct merge
65 } else {
66 set ct normal
70 proc update_status {{final Ready.}} {
71 global HEAD PARENT commit_type
72 global ui_index ui_other ui_status_value ui_comm
73 global status_active file_states
75 if {$status_active || ![lock_index read]} return
77 repository_state new_HEAD new_type
78 if {$commit_type == {amend}
79 && $new_type == {normal}
80 && $new_HEAD == $HEAD} {
81 } else {
82 set HEAD $new_HEAD
83 set PARENT $new_HEAD
84 set commit_type $new_type
87 array unset file_states
88 foreach w [list $ui_index $ui_other] {
89 $w conf -state normal
90 $w delete 0.0 end
91 $w conf -state disabled
94 if {![$ui_comm edit modified]
95 || [string trim [$ui_comm get 0.0 end]] == {}} {
96 if {[load_message GITGUI_MSG]} {
97 } elseif {[load_message MERGE_MSG]} {
98 } elseif {[load_message SQUASH_MSG]} {
100 $ui_comm edit modified false
103 set status_active 1
104 set ui_status_value {Refreshing file status...}
105 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
106 fconfigure $fd_rf -blocking 0 -translation binary
107 fileevent $fd_rf readable [list read_refresh $fd_rf $final]
110 proc read_refresh {fd final} {
111 global gitdir PARENT commit_type
112 global ui_index ui_other ui_status_value ui_comm
113 global status_active file_states
115 read $fd
116 if {![eof $fd]} return
117 close $fd
119 set ls_others [list | git ls-files --others -z \
120 --exclude-per-directory=.gitignore]
121 set info_exclude [file join $gitdir info exclude]
122 if {[file readable $info_exclude]} {
123 lappend ls_others "--exclude-from=$info_exclude"
126 set status_active 3
127 set ui_status_value {Scanning for modified files ...}
128 set fd_di [open "| git diff-index --cached -z $PARENT" r]
129 set fd_df [open "| git diff-files -z" r]
130 set fd_lo [open $ls_others r]
132 fconfigure $fd_di -blocking 0 -translation binary
133 fconfigure $fd_df -blocking 0 -translation binary
134 fconfigure $fd_lo -blocking 0 -translation binary
135 fileevent $fd_di readable [list read_diff_index $fd_di $final]
136 fileevent $fd_df readable [list read_diff_files $fd_df $final]
137 fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
140 proc load_message {file} {
141 global gitdir ui_comm
143 set f [file join $gitdir $file]
144 if {[file isfile $f]} {
145 if {[catch {set fd [open $f r]}]} {
146 return 0
148 set content [string trim [read $fd]]
149 close $fd
150 $ui_comm delete 0.0 end
151 $ui_comm insert end $content
152 return 1
154 return 0
157 proc read_diff_index {fd final} {
158 global buf_rdi
160 append buf_rdi [read $fd]
161 set pck [split $buf_rdi "\0"]
162 set buf_rdi [lindex $pck end]
163 foreach {m p} [lrange $pck 0 end-1] {
164 if {$m != {} && $p != {}} {
165 display_file $p [string index $m end]_
168 status_eof $fd buf_rdi $final
171 proc read_diff_files {fd final} {
172 global buf_rdf
174 append buf_rdf [read $fd]
175 set pck [split $buf_rdf "\0"]
176 set buf_rdf [lindex $pck end]
177 foreach {m p} [lrange $pck 0 end-1] {
178 if {$m != {} && $p != {}} {
179 display_file $p _[string index $m end]
182 status_eof $fd buf_rdf $final
185 proc read_ls_others {fd final} {
186 global buf_rlo
188 append buf_rlo [read $fd]
189 set pck [split $buf_rlo "\0"]
190 set buf_rlo [lindex $pck end]
191 foreach p [lrange $pck 0 end-1] {
192 display_file $p _O
194 status_eof $fd buf_rlo $final
197 proc status_eof {fd buf final} {
198 global status_active $buf
199 global ui_fname_value ui_status_value file_states
201 if {[eof $fd]} {
202 set $buf {}
203 close $fd
204 if {[incr status_active -1] == 0} {
205 unlock_index
207 set ui_status_value $final
208 if {$ui_fname_value != {} && [array names file_states \
209 -exact $ui_fname_value] != {}} {
210 show_diff $ui_fname_value
211 } else {
212 clear_diff
218 ######################################################################
220 ## diff
222 proc clear_diff {} {
223 global ui_diff ui_fname_value ui_fstatus_value
225 $ui_diff conf -state normal
226 $ui_diff delete 0.0 end
227 $ui_diff conf -state disabled
228 set ui_fname_value {}
229 set ui_fstatus_value {}
232 proc show_diff {path} {
233 global file_states PARENT diff_3way diff_active
234 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
236 if {$diff_active || ![lock_index read]} return
238 clear_diff
239 set s $file_states($path)
240 set m [lindex $s 0]
241 set diff_3way 0
242 set diff_active 1
243 set ui_fname_value $path
244 set ui_fstatus_value [mapdesc $m $path]
245 set ui_status_value "Loading diff of $path..."
247 set cmd [list | git diff-index -p $PARENT -- $path]
248 switch $m {
249 AM {
251 MM {
252 set cmd [list | git diff-index -p -c $PARENT $path]
254 _O {
255 if {[catch {
256 set fd [open $path r]
257 set content [read $fd]
258 close $fd
259 } err ]} {
260 set diff_active 0
261 unlock_index
262 set ui_status_value "Unable to display $path"
263 error_popup "Error loading file:\n$err"
264 return
266 $ui_diff conf -state normal
267 $ui_diff insert end $content
268 $ui_diff conf -state disabled
269 set diff_active 0
270 unlock_index
271 set ui_status_value {Ready.}
272 return
276 if {[catch {set fd [open $cmd r]} err]} {
277 set diff_active 0
278 unlock_index
279 set ui_status_value "Unable to display $path"
280 error_popup "Error loading diff:\n$err"
281 return
284 fconfigure $fd -blocking 0 -translation auto
285 fileevent $fd readable [list read_diff $fd]
288 proc read_diff {fd} {
289 global ui_diff ui_status_value diff_3way diff_active
291 while {[gets $fd line] >= 0} {
292 if {[string match {diff --git *} $line]} continue
293 if {[string match {diff --combined *} $line]} continue
294 if {[string match {--- *} $line]} continue
295 if {[string match {+++ *} $line]} continue
296 if {[string match index* $line]} {
297 if {[string first , $line] >= 0} {
298 set diff_3way 1
302 $ui_diff conf -state normal
303 if {!$diff_3way} {
304 set x [string index $line 0]
305 switch -- $x {
306 "@" {set tags da}
307 "+" {set tags dp}
308 "-" {set tags dm}
309 default {set tags {}}
311 } else {
312 set x [string range $line 0 1]
313 switch -- $x {
314 default {set tags {}}
315 "@@" {set tags da}
316 "++" {set tags dp; set x " +"}
317 " +" {set tags {di bold}; set x "++"}
318 "+ " {set tags dni; set x "-+"}
319 "--" {set tags dm; set x " -"}
320 " -" {set tags {dm bold}; set x "--"}
321 "- " {set tags di; set x "+-"}
322 default {set tags {}}
324 set line [string replace $line 0 1 $x]
326 $ui_diff insert end $line $tags
327 $ui_diff insert end "\n"
328 $ui_diff conf -state disabled
331 if {[eof $fd]} {
332 close $fd
333 set diff_active 0
334 unlock_index
335 set ui_status_value {Ready.}
339 ######################################################################
341 ## commit
343 proc load_last_commit {} {
344 global HEAD PARENT commit_type ui_comm
346 if {$commit_type == {amend}} return
347 if {$commit_type != {normal}} {
348 error_popup "Can't amend a $commit_type commit."
349 return
352 set msg {}
353 set parent {}
354 set parent_count 0
355 if {[catch {
356 set fd [open "| git cat-file commit $HEAD" r]
357 while {[gets $fd line] > 0} {
358 if {[string match {parent *} $line]} {
359 set parent [string range $line 7 end]
360 incr parent_count
363 set msg [string trim [read $fd]]
364 close $fd
365 } err]} {
366 error_popup "Error loading commit data for amend:\n$err"
367 return
370 if {$parent_count == 0} {
371 set commit_type amend
372 set HEAD {}
373 set PARENT {}
374 update_status
375 } elseif {$parent_count == 1} {
376 set commit_type amend
377 set PARENT $parent
378 $ui_comm delete 0.0 end
379 $ui_comm insert end $msg
380 $ui_comm edit modified false
381 update_status
382 } else {
383 error_popup {You can't amend a merge commit.}
384 return
388 proc commit_tree {} {
389 global tcl_platform HEAD gitdir commit_type file_states
390 global commit_active ui_status_value
391 global ui_comm
393 if {$commit_active || ![lock_index update]} return
395 # -- Our in memory state should match the repository.
397 repository_state curHEAD cur_type
398 if {$commit_type == {amend}
399 && $cur_type == {normal}
400 && $curHEAD == $HEAD} {
401 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
402 error_popup {Last scanned state does not match repository state.
404 Its highly likely that another Git program modified the
405 repository since our last scan. A rescan is required
406 before committing.
408 unlock_index
409 update_status
410 return
413 # -- At least one file should differ in the index.
415 set files_ready 0
416 foreach path [array names file_states] {
417 set s $file_states($path)
418 switch -glob -- [lindex $s 0] {
419 _* {continue}
420 A* -
421 D* -
422 M* {set files_ready 1; break}
423 U* {
424 error_popup "Unmerged files cannot be committed.
426 File $path has merge conflicts.
427 You must resolve them and check the file in before committing.
429 unlock_index
430 return
432 default {
433 error_popup "Unknown file state [lindex $s 0] detected.
435 File $path cannot be committed by this program.
440 if {!$files_ready} {
441 error_popup {No checked-in files to commit.
443 You must check-in at least 1 file before you can commit.
445 unlock_index
446 return
449 # -- A message is required.
451 set msg [string trim [$ui_comm get 1.0 end]]
452 if {$msg == {}} {
453 error_popup {Please supply a commit message.
455 A good commit message has the following format:
457 - First line: Describe in one sentance what you did.
458 - Second line: Blank
459 - Remaining lines: Describe why this change is good.
461 unlock_index
462 return
465 # -- Ask the pre-commit hook for the go-ahead.
467 set pchook [file join $gitdir hooks pre-commit]
468 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
469 set pchook [list sh -c \
470 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
471 } elseif {[file executable $pchook]} {
472 set pchook [list $pchook]
473 } else {
474 set pchook {}
476 if {$pchook != {} && [catch {eval exec $pchook} err]} {
477 hook_failed_popup pre-commit $err
478 unlock_index
479 return
482 # -- Write the tree in the background.
484 set commit_active 1
485 set ui_status_value {Committing changes...}
487 set fd_wt [open "| git write-tree" r]
488 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
491 proc commit_stage2 {fd_wt curHEAD msg} {
492 global single_commit gitdir PARENT commit_type
493 global commit_active ui_status_value ui_comm
495 gets $fd_wt tree_id
496 close $fd_wt
498 if {$tree_id == {}} {
499 error_popup "write-tree failed"
500 set commit_active 0
501 set ui_status_value {Commit failed.}
502 unlock_index
503 return
506 # -- Create the commit.
508 set cmd [list git commit-tree $tree_id]
509 if {$PARENT != {}} {
510 lappend cmd -p $PARENT
512 if {$commit_type == {merge}} {
513 if {[catch {
514 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
515 while {[gets $fd_mh merge_head] >= 0} {
516 lappend cmd -p $merge_head
518 close $fd_mh
519 } err]} {
520 error_popup "Loading MERGE_HEADs failed:\n$err"
521 set commit_active 0
522 set ui_status_value {Commit failed.}
523 unlock_index
524 return
527 if {$PARENT == {}} {
528 # git commit-tree writes to stderr during initial commit.
529 lappend cmd 2>/dev/null
531 lappend cmd << $msg
532 if {[catch {set cmt_id [eval exec $cmd]} err]} {
533 error_popup "commit-tree failed:\n$err"
534 set commit_active 0
535 set ui_status_value {Commit failed.}
536 unlock_index
537 return
540 # -- Update the HEAD ref.
542 set reflogm commit
543 if {$commit_type != {normal}} {
544 append reflogm " ($commit_type)"
546 set i [string first "\n" $msg]
547 if {$i >= 0} {
548 append reflogm {: } [string range $msg 0 [expr $i - 1]]
549 } else {
550 append reflogm {: } $msg
552 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
553 if {[catch {eval exec $cmd} err]} {
554 error_popup "update-ref failed:\n$err"
555 set commit_active 0
556 set ui_status_value {Commit failed.}
557 unlock_index
558 return
561 # -- Cleanup after ourselves.
563 catch {file delete [file join $gitdir MERGE_HEAD]}
564 catch {file delete [file join $gitdir MERGE_MSG]}
565 catch {file delete [file join $gitdir SQUASH_MSG]}
566 catch {file delete [file join $gitdir GITGUI_MSG]}
568 # -- Let rerere do its thing.
570 if {[file isdirectory [file join $gitdir rr-cache]]} {
571 catch {exec git rerere}
574 $ui_comm delete 0.0 end
575 $ui_comm edit modified false
577 if {$single_commit} do_quit
579 set commit_type {}
580 set commit_active 0
581 set HEAD $cmt_id
582 set PARENT $cmt_id
583 unlock_index
584 update_status "Changes committed as $cmt_id."
587 ######################################################################
589 ## fetch pull push
591 proc fetch_from {remote} {
592 set w [new_console "fetch $remote" \
593 "Fetching new changes from $remote"]
594 set cmd [list git fetch]
595 lappend cmd -v
596 lappend cmd $remote
597 console_exec $w $cmd
600 proc push_to {remote} {
601 set w [new_console "push $remote" \
602 "Pushing changes to $remote"]
603 set cmd [list git push]
604 lappend -v
605 lappend cmd $remote
606 console_exec $w $cmd
609 ######################################################################
611 ## ui helpers
613 proc mapcol {state path} {
614 global all_cols
616 if {[catch {set r $all_cols($state)}]} {
617 puts "error: no column for state={$state} $path"
618 return o
620 return $r
623 proc mapicon {state path} {
624 global all_icons
626 if {[catch {set r $all_icons($state)}]} {
627 puts "error: no icon for state={$state} $path"
628 return file_plain
630 return $r
633 proc mapdesc {state path} {
634 global all_descs
636 if {[catch {set r $all_descs($state)}]} {
637 puts "error: no desc for state={$state} $path"
638 return $state
640 return $r
643 proc bsearch {w path} {
644 set hi [expr [lindex [split [$w index end] .] 0] - 2]
645 if {$hi == 0} {
646 return -1
648 set lo 0
649 while {$lo < $hi} {
650 set mi [expr [expr $lo + $hi] / 2]
651 set ti [expr $mi + 1]
652 set cmp [string compare [$w get $ti.1 $ti.end] $path]
653 if {$cmp < 0} {
654 set lo $ti
655 } elseif {$cmp == 0} {
656 return $mi
657 } else {
658 set hi $mi
661 return -[expr $lo + 1]
664 proc merge_state {path state} {
665 global file_states
667 if {[array names file_states -exact $path] == {}} {
668 set o __
669 set s [list $o none none]
670 } else {
671 set s $file_states($path)
672 set o [lindex $s 0]
675 set m [lindex $s 0]
676 if {[string index $state 0] == "_"} {
677 set state [string index $m 0][string index $state 1]
678 } elseif {[string index $state 0] == "*"} {
679 set state _[string index $state 1]
682 if {[string index $state 1] == "_"} {
683 set state [string index $state 0][string index $m 1]
684 } elseif {[string index $state 1] == "*"} {
685 set state [string index $state 0]_
688 set file_states($path) [lreplace $s 0 0 $state]
689 return $o
692 proc display_file {path state} {
693 global ui_index ui_other file_states
695 set old_m [merge_state $path $state]
696 set s $file_states($path)
697 set m [lindex $s 0]
699 if {[mapcol $m $path] == "o"} {
700 set ii 1
701 set ai 2
702 set iw $ui_index
703 set aw $ui_other
704 } else {
705 set ii 2
706 set ai 1
707 set iw $ui_other
708 set aw $ui_index
711 set d [lindex $s $ii]
712 if {$d != "none"} {
713 set lno [bsearch $iw $path]
714 if {$lno >= 0} {
715 incr lno
716 $iw conf -state normal
717 $iw delete $lno.0 [expr $lno + 1].0
718 $iw conf -state disabled
719 set s [lreplace $s $ii $ii none]
723 set d [lindex $s $ai]
724 if {$d == "none"} {
725 set lno [expr abs([bsearch $aw $path] + 1) + 1]
726 $aw conf -state normal
727 set ico [$aw image create $lno.0 \
728 -align center -padx 5 -pady 1 \
729 -image [mapicon $m $path]]
730 $aw insert $lno.1 "$path\n"
731 $aw conf -state disabled
732 set file_states($path) [lreplace $s $ai $ai [list $ico]]
733 } elseif {[mapicon $m $path] != [mapicon $old_m $path]} {
734 set ico [lindex $d 0]
735 $aw image conf $ico -image [mapicon $m $path]
739 proc with_update_index {body} {
740 global update_index_fd
742 if {$update_index_fd == {}} {
743 if {![lock_index update]} return
744 set update_index_fd [open \
745 "| git update-index --add --remove -z --stdin" \
747 fconfigure $update_index_fd -translation binary
748 uplevel 1 $body
749 close $update_index_fd
750 set update_index_fd {}
751 unlock_index
752 } else {
753 uplevel 1 $body
757 proc update_index {path} {
758 global update_index_fd
760 if {$update_index_fd == {}} {
761 error {not in with_update_index}
762 } else {
763 puts -nonewline $update_index_fd "$path\0"
767 proc toggle_mode {path} {
768 global file_states ui_fname_value
770 set s $file_states($path)
771 set m [lindex $s 0]
773 switch -- $m {
774 AM -
775 _O {set new A*}
776 _M -
777 MM {set new M*}
778 AD -
779 _D {set new D*}
780 default {return}
783 with_update_index {update_index $path}
784 display_file $path $new
785 if {$ui_fname_value == $path} {
786 show_diff $path
790 ######################################################################
792 ## config (fetch push pull)
794 proc load_all_remotes {} {
795 global gitdir all_remotes
797 set all_remotes [list]
798 set rm_dir [file join $gitdir remotes]
799 if {[file isdirectory $rm_dir]} {
800 set all_remotes [concat $all_remotes \
801 [glob -types f -tails -directory $rm_dir * *]]
804 set fd_rc [open "| git repo-config --list" r]
805 while {[gets $fd_rc line] >= 0} {
806 if {[regexp ^remote\.(.*)\.url= $line line name]} {
807 lappend all_remotes $name
810 close $fd_rc
812 set all_remotes [lsort -unique $all_remotes]
815 proc populate_remote_menu {m pfx op} {
816 global gitdir all_remotes mainfont
818 foreach remote $all_remotes {
819 $m add command -label "$pfx $remote..." \
820 -command [list $op $remote] \
821 -font $mainfont
825 ######################################################################
827 ## icons
829 set filemask {
830 #define mask_width 14
831 #define mask_height 15
832 static unsigned char mask_bits[] = {
833 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
834 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
835 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
838 image create bitmap file_plain -background white -foreground black -data {
839 #define plain_width 14
840 #define plain_height 15
841 static unsigned char plain_bits[] = {
842 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
843 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
844 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
845 } -maskdata $filemask
847 image create bitmap file_mod -background white -foreground blue -data {
848 #define mod_width 14
849 #define mod_height 15
850 static unsigned char mod_bits[] = {
851 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
852 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
853 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
854 } -maskdata $filemask
856 image create bitmap file_fulltick -background white -foreground "#007000" -data {
857 #define file_fulltick_width 14
858 #define file_fulltick_height 15
859 static unsigned char file_fulltick_bits[] = {
860 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
861 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
862 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
863 } -maskdata $filemask
865 image create bitmap file_parttick -background white -foreground "#005050" -data {
866 #define parttick_width 14
867 #define parttick_height 15
868 static unsigned char parttick_bits[] = {
869 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
870 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
871 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
872 } -maskdata $filemask
874 image create bitmap file_question -background white -foreground black -data {
875 #define file_question_width 14
876 #define file_question_height 15
877 static unsigned char file_question_bits[] = {
878 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
879 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
880 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
881 } -maskdata $filemask
883 image create bitmap file_removed -background white -foreground red -data {
884 #define file_removed_width 14
885 #define file_removed_height 15
886 static unsigned char file_removed_bits[] = {
887 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
888 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
889 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
890 } -maskdata $filemask
892 image create bitmap file_merge -background white -foreground blue -data {
893 #define file_merge_width 14
894 #define file_merge_height 15
895 static unsigned char file_merge_bits[] = {
896 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
897 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
898 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
899 } -maskdata $filemask
901 set max_status_desc 0
902 foreach i {
903 {__ i plain "Unmodified"}
904 {_M i mod "Modified"}
905 {M_ i fulltick "Checked in"}
906 {MM i parttick "Partially checked in"}
908 {_O o plain "Untracked"}
909 {A_ o fulltick "Added"}
910 {AM o parttick "Partially added"}
911 {AD o question "Added (but now gone)"}
913 {_D i question "Missing"}
914 {D_ i removed "Removed"}
915 {DD i removed "Removed"}
916 {DO i removed "Removed (still exists)"}
918 {UM i merge "Merge conflicts"}
919 {U_ i merge "Merge conflicts"}
921 if {$max_status_desc < [string length [lindex $i 3]]} {
922 set max_status_desc [string length [lindex $i 3]]
924 set all_cols([lindex $i 0]) [lindex $i 1]
925 set all_icons([lindex $i 0]) file_[lindex $i 2]
926 set all_descs([lindex $i 0]) [lindex $i 3]
928 unset filemask i
930 ######################################################################
932 ## util
934 proc error_popup {msg} {
935 set w .error
936 toplevel $w
937 wm transient $w .
938 show_msg $w $w $msg
941 proc show_msg {w top msg} {
942 global gitdir appname
944 message $w.m -text $msg -justify left -aspect 400
945 pack $w.m -side top -fill x -padx 5 -pady 10
946 button $w.ok -text OK \
947 -width 15 \
948 -font $mainfont \
949 -command "destroy $top"
950 pack $w.ok -side bottom
951 bind $top <Visibility> "grab $top; focus $top"
952 bind $top <Key-Return> "destroy $top"
953 wm title $top "error: $appname ([file normalize [file dirname $gitdir]])"
954 tkwait window $top
957 proc hook_failed_popup {hook msg} {
958 global gitdir mainfont difffont appname
960 set w .hookfail
961 toplevel $w
962 wm transient $w .
964 frame $w.m
965 label $w.m.l1 -text "$hook hook failed:" \
966 -anchor w \
967 -justify left \
968 -font [concat $mainfont bold]
969 text $w.m.t \
970 -background white -borderwidth 1 \
971 -relief sunken \
972 -width 80 -height 10 \
973 -font $difffont \
974 -yscrollcommand [list $w.m.sby set]
975 label $w.m.l2 \
976 -text {You must correct the above errors before committing.} \
977 -anchor w \
978 -justify left \
979 -font [concat $mainfont bold]
980 scrollbar $w.m.sby -command [list $w.m.t yview]
981 pack $w.m.l1 -side top -fill x
982 pack $w.m.l2 -side bottom -fill x
983 pack $w.m.sby -side right -fill y
984 pack $w.m.t -side left -fill both -expand 1
985 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
987 $w.m.t insert 1.0 $msg
988 $w.m.t conf -state disabled
990 button $w.ok -text OK \
991 -width 15 \
992 -font $mainfont \
993 -command "destroy $w"
994 pack $w.ok -side bottom
996 bind $w <Visibility> "grab $w; focus $w"
997 bind $w <Key-Return> "destroy $w"
998 wm title $w "error: $appname ([file normalize [file dirname $gitdir]])"
999 tkwait window $w
1002 set next_console_id 0
1004 proc new_console {short_title long_title} {
1005 global next_console_id gitdir appname mainfont difffont
1007 set w .console[incr next_console_id]
1008 toplevel $w
1009 frame $w.m
1010 label $w.m.l1 -text "$long_title:" \
1011 -anchor w \
1012 -justify left \
1013 -font [concat $mainfont bold]
1014 text $w.m.t \
1015 -background white -borderwidth 1 \
1016 -relief sunken \
1017 -width 80 -height 10 \
1018 -font $difffont \
1019 -state disabled \
1020 -yscrollcommand [list $w.m.sby set]
1021 scrollbar $w.m.sby -command [list $w.m.t yview]
1022 pack $w.m.l1 -side top -fill x
1023 pack $w.m.sby -side right -fill y
1024 pack $w.m.t -side left -fill both -expand 1
1025 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1027 button $w.ok -text {OK} \
1028 -width 15 \
1029 -font $mainfont \
1030 -state disabled \
1031 -command "destroy $w"
1032 pack $w.ok -side bottom
1034 bind $w <Visibility> "focus $w"
1035 bind $w <Destroy> break
1036 wm title $w "$appname ([file dirname [file normalize [file dirname $gitdir]]]): $short_title"
1037 return $w
1040 proc console_exec {w cmd} {
1041 global tcl_platform
1043 # -- Windows tosses the enviroment when we exec our child.
1044 # But most users need that so we have to relogin. :-(
1046 if {$tcl_platform(platform) == {windows}} {
1047 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1050 # -- Tcl won't let us redirect both stdout and stderr to
1051 # the same pipe. So pass it through cat...
1053 set cmd [concat | $cmd |& cat]
1055 set fd_f [open $cmd r]
1056 fconfigure $fd_f -blocking 0 -translation auto
1057 fileevent $fd_f readable [list console_read $w $fd_f]
1060 proc console_read {w fd} {
1061 $w.m.t conf -state normal
1062 while {[gets $fd line] >= 0} {
1063 $w.m.t insert end $line
1064 $w.m.t insert end "\n"
1066 $w.m.t conf -state disabled
1067 $w.m.t see end
1069 if {[eof $fd]} {
1070 close $fd
1071 $w.ok conf -state normal
1075 ######################################################################
1077 ## ui commands
1079 set starting_gitk_msg {Please wait... Starting gitk...}
1081 proc do_gitk {} {
1082 global tcl_platform ui_status_value starting_gitk_msg
1084 set ui_status_value $starting_gitk_msg
1085 after 10000 {
1086 if {$ui_status_value == $starting_gitk_msg} {
1087 set ui_status_value {Ready.}
1091 if {$tcl_platform(platform) == {windows}} {
1092 exec sh -c gitk &
1093 } else {
1094 exec gitk &
1098 proc do_quit {} {
1099 global gitdir ui_comm
1101 set save [file join $gitdir GITGUI_MSG]
1102 set msg [string trim [$ui_comm get 0.0 end]]
1103 if {[$ui_comm edit modified] && $msg != {}} {
1104 catch {
1105 set fd [open $save w]
1106 puts $fd [string trim [$ui_comm get 0.0 end]]
1107 close $fd
1109 } elseif {$msg == {} && [file exists $save]} {
1110 file delete $save
1113 destroy .
1116 proc do_rescan {} {
1117 update_status
1120 proc do_checkin_all {} {
1121 global checkin_active ui_status_value
1123 if {$checkin_active || ![lock_index begin-update]} return
1125 set checkin_active 1
1126 set ui_status_value {Checking in all files...}
1127 after 1 {
1128 with_update_index {
1129 foreach path [array names file_states] {
1130 set s $file_states($path)
1131 set m [lindex $s 0]
1132 switch -- $m {
1133 AM -
1134 MM -
1135 _M -
1136 _D {toggle_mode $path}
1140 set checkin_active 0
1141 set ui_status_value {Ready.}
1145 proc do_signoff {} {
1146 global ui_comm
1148 catch {
1149 set me [exec git var GIT_COMMITTER_IDENT]
1150 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1151 set str "Signed-off-by: $name"
1152 if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1153 $ui_comm insert end "\n"
1154 $ui_comm insert end $str
1155 $ui_comm see end
1161 proc do_amend_last {} {
1162 load_last_commit
1165 proc do_commit {} {
1166 commit_tree
1169 # shift == 1: left click
1170 # 3: right click
1171 proc click {w x y shift wx wy} {
1172 global ui_index ui_other
1174 set pos [split [$w index @$x,$y] .]
1175 set lno [lindex $pos 0]
1176 set col [lindex $pos 1]
1177 set path [$w get $lno.1 $lno.end]
1178 if {$path == {}} return
1180 if {$col > 0 && $shift == 1} {
1181 $ui_index tag remove in_diff 0.0 end
1182 $ui_other tag remove in_diff 0.0 end
1183 $w tag add in_diff $lno.0 [expr $lno + 1].0
1184 show_diff $path
1188 proc unclick {w x y} {
1189 set pos [split [$w index @$x,$y] .]
1190 set lno [lindex $pos 0]
1191 set col [lindex $pos 1]
1192 set path [$w get $lno.1 $lno.end]
1193 if {$path == {}} return
1195 if {$col == 0} {
1196 toggle_mode $path
1200 ######################################################################
1202 ## ui init
1204 set mainfont {Helvetica 10}
1205 set difffont {Courier 10}
1206 set maincursor [. cget -cursor]
1208 switch -- $tcl_platform(platform) {
1209 windows {set M1B Control; set M1T Ctrl}
1210 default {set M1B M1; set M1T M1}
1213 # -- Menu Bar
1214 menu .mbar -tearoff 0
1215 .mbar add cascade -label Project -menu .mbar.project
1216 .mbar add cascade -label Commit -menu .mbar.commit
1217 .mbar add cascade -label Fetch -menu .mbar.fetch
1218 .mbar add cascade -label Pull -menu .mbar.pull
1219 .mbar add cascade -label Push -menu .mbar.push
1220 . configure -menu .mbar
1222 # -- Project Menu
1223 menu .mbar.project
1224 .mbar.project add command -label Visualize \
1225 -command do_gitk \
1226 -font $mainfont
1227 .mbar.project add command -label Quit \
1228 -command do_quit \
1229 -accelerator $M1T-Q \
1230 -font $mainfont
1232 # -- Commit Menu
1233 menu .mbar.commit
1234 .mbar.commit add command -label Rescan \
1235 -command do_rescan \
1236 -accelerator F5 \
1237 -font $mainfont
1238 lappend disable_on_lock \
1239 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1240 .mbar.commit add command -label {Amend Last Commit} \
1241 -command do_amend_last \
1242 -font $mainfont
1243 lappend disable_on_lock \
1244 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1245 .mbar.commit add command -label {Check-in All Files} \
1246 -command do_checkin_all \
1247 -accelerator $M1T-U \
1248 -font $mainfont
1249 lappend disable_on_lock \
1250 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1251 .mbar.commit add command -label {Sign Off} \
1252 -command do_signoff \
1253 -accelerator $M1T-S \
1254 -font $mainfont
1255 .mbar.commit add command -label Commit \
1256 -command do_commit \
1257 -accelerator $M1T-Return \
1258 -font $mainfont
1259 lappend disable_on_lock \
1260 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1262 # -- Fetch Menu
1263 menu .mbar.fetch
1265 # -- Pull Menu
1266 menu .mbar.pull
1268 # -- Push Menu
1269 menu .mbar.push
1271 # -- Main Window Layout
1272 panedwindow .vpane -orient vertical
1273 panedwindow .vpane.files -orient horizontal
1274 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1275 pack .vpane -anchor n -side top -fill both -expand 1
1277 # -- Index File List
1278 set ui_index .vpane.files.index.list
1279 frame .vpane.files.index -height 100 -width 400
1280 label .vpane.files.index.title -text {Modified Files} \
1281 -background green \
1282 -font $mainfont
1283 text $ui_index -background white -borderwidth 0 \
1284 -width 40 -height 10 \
1285 -font $mainfont \
1286 -yscrollcommand {.vpane.files.index.sb set} \
1287 -cursor $maincursor \
1288 -state disabled
1289 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1290 pack .vpane.files.index.title -side top -fill x
1291 pack .vpane.files.index.sb -side right -fill y
1292 pack $ui_index -side left -fill both -expand 1
1293 .vpane.files add .vpane.files.index -sticky nsew
1295 # -- Other (Add) File List
1296 set ui_other .vpane.files.other.list
1297 frame .vpane.files.other -height 100 -width 100
1298 label .vpane.files.other.title -text {Untracked Files} \
1299 -background red \
1300 -font $mainfont
1301 text $ui_other -background white -borderwidth 0 \
1302 -width 40 -height 10 \
1303 -font $mainfont \
1304 -yscrollcommand {.vpane.files.other.sb set} \
1305 -cursor $maincursor \
1306 -state disabled
1307 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1308 pack .vpane.files.other.title -side top -fill x
1309 pack .vpane.files.other.sb -side right -fill y
1310 pack $ui_other -side left -fill both -expand 1
1311 .vpane.files add .vpane.files.other -sticky nsew
1313 $ui_index tag conf in_diff -font [concat $mainfont bold]
1314 $ui_other tag conf in_diff -font [concat $mainfont bold]
1316 # -- Diff Header
1317 set ui_fname_value {}
1318 set ui_fstatus_value {}
1319 frame .vpane.diff -height 200 -width 400
1320 frame .vpane.diff.header
1321 label .vpane.diff.header.l1 -text {File:} -font $mainfont
1322 label .vpane.diff.header.l2 -textvariable ui_fname_value \
1323 -anchor w \
1324 -justify left \
1325 -font $mainfont
1326 label .vpane.diff.header.l3 -text {Status:} -font $mainfont
1327 label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
1328 -width $max_status_desc \
1329 -anchor w \
1330 -justify left \
1331 -font $mainfont
1332 pack .vpane.diff.header.l1 -side left
1333 pack .vpane.diff.header.l2 -side left -fill x
1334 pack .vpane.diff.header.l4 -side right
1335 pack .vpane.diff.header.l3 -side right
1337 # -- Diff Body
1338 frame .vpane.diff.body
1339 set ui_diff .vpane.diff.body.t
1340 text $ui_diff -background white -borderwidth 0 \
1341 -width 80 -height 15 -wrap none \
1342 -font $difffont \
1343 -xscrollcommand {.vpane.diff.body.sbx set} \
1344 -yscrollcommand {.vpane.diff.body.sby set} \
1345 -cursor $maincursor \
1346 -state disabled
1347 scrollbar .vpane.diff.body.sbx -orient horizontal \
1348 -command [list $ui_diff xview]
1349 scrollbar .vpane.diff.body.sby -orient vertical \
1350 -command [list $ui_diff yview]
1351 pack .vpane.diff.body.sbx -side bottom -fill x
1352 pack .vpane.diff.body.sby -side right -fill y
1353 pack $ui_diff -side left -fill both -expand 1
1354 pack .vpane.diff.header -side top -fill x
1355 pack .vpane.diff.body -side bottom -fill both -expand 1
1356 .vpane add .vpane.diff -stick nsew
1358 $ui_diff tag conf dm -foreground red
1359 $ui_diff tag conf dp -foreground blue
1360 $ui_diff tag conf da -font [concat $difffont bold]
1361 $ui_diff tag conf di -foreground "#00a000"
1362 $ui_diff tag conf dni -foreground "#a000a0"
1363 $ui_diff tag conf bold -font [concat $difffont bold]
1365 # -- Commit Area
1366 frame .vpane.commarea -height 170
1367 .vpane add .vpane.commarea -stick nsew
1369 # -- Commit Area Buttons
1370 frame .vpane.commarea.buttons
1371 label .vpane.commarea.buttons.l -text {} \
1372 -anchor w \
1373 -justify left \
1374 -font $mainfont
1375 pack .vpane.commarea.buttons.l -side top -fill x
1376 pack .vpane.commarea.buttons -side left -fill y
1378 button .vpane.commarea.buttons.rescan -text {Rescan} \
1379 -command do_rescan \
1380 -font $mainfont
1381 pack .vpane.commarea.buttons.rescan -side top -fill x
1382 lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1384 button .vpane.commarea.buttons.amend -text {Amend Last} \
1385 -command do_amend_last \
1386 -font $mainfont
1387 pack .vpane.commarea.buttons.amend -side top -fill x
1388 lappend disable_on_lock {.vpane.commarea.buttons.amend conf -state}
1390 button .vpane.commarea.buttons.ciall -text {Check-in All} \
1391 -command do_checkin_all \
1392 -font $mainfont
1393 pack .vpane.commarea.buttons.ciall -side top -fill x
1394 lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1396 button .vpane.commarea.buttons.signoff -text {Sign Off} \
1397 -command do_signoff \
1398 -font $mainfont
1399 pack .vpane.commarea.buttons.signoff -side top -fill x
1401 button .vpane.commarea.buttons.commit -text {Commit} \
1402 -command do_commit \
1403 -font $mainfont
1404 pack .vpane.commarea.buttons.commit -side top -fill x
1405 lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1407 # -- Commit Message Buffer
1408 frame .vpane.commarea.buffer
1409 set ui_comm .vpane.commarea.buffer.t
1410 set ui_coml .vpane.commarea.buffer.l
1411 label $ui_coml -text {Commit Message:} \
1412 -anchor w \
1413 -justify left \
1414 -font $mainfont
1415 trace add variable commit_type write {uplevel #0 {
1416 switch -glob $commit_type \
1417 initial {$ui_coml conf -text {Initial Commit Message:}} \
1418 amend {$ui_coml conf -text {Amended Commit Message:}} \
1419 merge {$ui_coml conf -text {Merge Commit Message:}} \
1420 * {$ui_coml conf -text {Commit Message:}}
1422 text $ui_comm -background white -borderwidth 1 \
1423 -relief sunken \
1424 -width 75 -height 10 -wrap none \
1425 -font $difffont \
1426 -yscrollcommand {.vpane.commarea.buffer.sby set} \
1427 -cursor $maincursor
1428 scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1429 pack $ui_coml -side top -fill x
1430 pack .vpane.commarea.buffer.sby -side right -fill y
1431 pack $ui_comm -side left -fill y
1432 pack .vpane.commarea.buffer -side left -fill y
1434 # -- Status Bar
1435 set ui_status_value {Initializing...}
1436 label .status -textvariable ui_status_value \
1437 -anchor w \
1438 -justify left \
1439 -borderwidth 1 \
1440 -relief sunken \
1441 -font $mainfont
1442 pack .status -anchor w -side bottom -fill x
1444 # -- Key Bindings
1445 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1446 bind . <Destroy> do_quit
1447 bind . <Key-F5> do_rescan
1448 bind . <$M1B-Key-r> do_rescan
1449 bind . <$M1B-Key-R> do_rescan
1450 bind . <$M1B-Key-s> do_signoff
1451 bind . <$M1B-Key-S> do_signoff
1452 bind . <$M1B-Key-u> do_checkin_all
1453 bind . <$M1B-Key-U> do_checkin_all
1454 bind . <$M1B-Key-Return> do_commit
1455 bind . <$M1B-Key-q> do_quit
1456 bind . <$M1B-Key-Q> do_quit
1457 foreach i [list $ui_index $ui_other] {
1458 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1459 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1460 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1462 unset i M1B M1T
1464 ######################################################################
1466 ## main
1468 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1469 show_msg {} . "Cannot find the git directory: $err"
1470 exit 1
1472 set cdup [exec git rev-parse --show-cdup]
1473 if {$cdup != ""} {
1474 cd $cdup
1476 unset cdup
1478 set appname [lindex [file split $argv0] end]
1479 if {$appname == {git-citool}} {
1480 set single_commit 1
1483 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1484 focus -force $ui_comm
1485 load_all_remotes
1486 populate_remote_menu .mbar.fetch From fetch_from
1487 populate_remote_menu .mbar.push To push_to
1488 update_status