2 # Tcl ignores the next line -*- tcl -*- \
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 ######################################################################
19 set update_index_fd
{}
21 set disable_on_lock
[list
]
22 set index_lock_type none
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
37 } elseif
{$index_lock_type == {begin-update
} && $type == {update
}} {
38 set index_lock_type
$type
44 proc unlock_index
{} {
45 global index_lock_type disable_on_lock
47 set index_lock_type none
48 foreach w
$disable_on_lock {
53 ######################################################################
57 proc repository_state
{hdvar ctvar
} {
59 upvar
$hdvar hd
$ctvar ct
61 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
63 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
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} {
84 set commit_type
$new_type
87 array
unset file_states
88 foreach w
[list
$ui_index $ui_other] {
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
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
116 if {![eof
$fd]} return
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"
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
]}]} {
148 set content
[string trim
[read $fd]]
150 $ui_comm delete
0.0 end
151 $ui_comm insert end
$content
157 proc read_diff_index
{fd final
} {
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
} {
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
} {
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
] {
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
204 if {[incr status_active
-1] == 0} {
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
218 ######################################################################
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
239 set s
$file_states($path)
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]
252 set cmd
[list | git diff-index
-p -c $PARENT $path]
256 set fd
[open
$path r
]
257 set content
[read $fd]
262 set ui_status_value
"Unable to display $path"
263 error_popup
"Error loading file:\n$err"
266 $ui_diff conf
-state normal
267 $ui_diff insert end
$content
268 $ui_diff conf
-state disabled
271 set ui_status_value
{Ready.
}
276 if {[catch
{set fd
[open
$cmd r
]} err
]} {
279 set ui_status_value
"Unable to display $path"
280 error_popup
"Error loading diff:\n$err"
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} {
302 $ui_diff conf
-state normal
304 set x
[string index
$line 0]
309 default
{set tags
{}}
312 set x
[string range
$line 0 1]
314 default
{set tags
{}}
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
335 set ui_status_value
{Ready.
}
339 ######################################################################
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."
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
]
363 set msg
[string trim
[read $fd]]
366 error_popup
"Error loading commit data for amend:\n$err"
370 if {$parent_count == 0} {
371 set commit_type amend
375 } elseif
{$parent_count == 1} {
376 set commit_type amend
378 $ui_comm delete
0.0 end
379 $ui_comm insert end
$msg
380 $ui_comm edit modified false
383 error_popup
{You can
't amend a merge commit.}
388 proc commit_tree {} {
389 global tcl_platform HEAD gitdir commit_type file_states
390 global commit_active ui_status_value
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
413 # -- At least one file should differ in the index.
416 foreach path [array names file_states] {
417 set s $file_states($path)
418 switch -glob -- [lindex $s 0] {
422 M* {set files_ready 1; break}
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.
433 error_popup "Unknown file state [lindex $s 0] detected.
435 File $path cannot be committed by this program.
441 error_popup {No checked-in files to commit.
443 You must check-in at least 1 file before you can commit.
449 # -- A message is required.
451 set msg [string trim [$ui_comm get 1.0 end]]
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.
459 - Remaining lines: Describe why this change is good.
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]
476 if {$pchook != {} && [catch {eval exec $pchook} err]} {
477 hook_failed_popup pre-commit $err
482 # -- Write the tree in the background.
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
498 if {$tree_id == {}} {
499 error_popup "write-tree failed"
501 set ui_status_value {Commit failed.}
506 # -- Create the commit.
508 set cmd [list git commit-tree $tree_id]
510 lappend cmd -p $PARENT
512 if {$commit_type == {merge}} {
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
520 error_popup "Loading MERGE_HEADs failed:\n$err"
522 set ui_status_value {Commit failed.}
528 # git commit-tree writes to stderr during initial commit.
529 lappend cmd 2>/dev/null
532 if {[catch {set cmt_id [eval exec $cmd]} err]} {
533 error_popup "commit-tree failed:\n$err"
535 set ui_status_value {Commit failed.}
540 # -- Update the HEAD ref.
543 if {$commit_type != {normal}} {
544 append reflogm " ($commit_type)"
546 set i [string first "\n" $msg]
548 append reflogm {: } [string range $msg 0 [expr $i - 1]]
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"
556 set ui_status_value {Commit failed.}
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
584 update_status "Changes committed as $cmt_id."
587 ######################################################################
591 proc fetch_from {remote} {
592 set w [new_console "fetch $remote" \
593 "Fetching new changes from $remote"]
594 set cmd [list | git fetch]
598 set fd_f [open $cmd r]
599 fconfigure $fd_f -blocking 0 -translation auto
600 fileevent $fd_f readable [list console_read $w $fd_f]
603 proc push_to {remote} {
604 set w [new_console "push $remote" \
605 "Pushing changes to $remote"]
606 set cmd [list | git push]
610 set fd_f [open $cmd r]
611 fconfigure $fd_f -blocking 0 -translation auto
612 fileevent $fd_f readable [list console_read $w $fd_f]
615 ######################################################################
619 proc mapcol {state path} {
622 if {[catch {set r $all_cols($state)}]} {
623 puts "error: no column for state={$state} $path"
629 proc mapicon {state path} {
632 if {[catch {set r $all_icons($state)}]} {
633 puts "error: no icon for state={$state} $path"
639 proc mapdesc {state path} {
642 if {[catch {set r $all_descs($state)}]} {
643 puts "error: no desc for state={$state} $path"
649 proc bsearch {w path} {
650 set hi [expr [lindex [split [$w index end] .] 0] - 2]
656 set mi [expr [expr $lo + $hi] / 2]
657 set ti [expr $mi + 1]
658 set cmp [string compare [$w get $ti.1 $ti.end] $path]
661 } elseif {$cmp == 0} {
667 return -[expr $lo + 1]
670 proc merge_state {path state} {
673 if {[array names file_states -exact $path] == {}} {
675 set s [list $o none none]
677 set s $file_states($path)
682 if {[string index $state 0] == "_"} {
683 set state [string index $m 0][string index $state 1]
684 } elseif {[string index $state 0] == "*"} {
685 set state _[string index $state 1]
688 if {[string index $state 1] == "_"} {
689 set state [string index $state 0][string index $m 1]
690 } elseif {[string index $state 1] == "*"} {
691 set state [string index $state 0]_
694 set file_states($path) [lreplace $s 0 0 $state]
698 proc display_file {path state} {
699 global ui_index ui_other file_states
701 set old_m [merge_state $path $state]
702 set s $file_states($path)
705 if {[mapcol $m $path] == "o"} {
717 set d [lindex $s $ii]
719 set lno [bsearch $iw $path]
722 $iw conf -state normal
723 $iw delete $lno.0 [expr $lno + 1].0
724 $iw conf -state disabled
725 set s [lreplace $s $ii $ii none]
729 set d [lindex $s $ai]
731 set lno [expr abs([bsearch $aw $path] + 1) + 1]
732 $aw conf -state normal
733 set ico [$aw image create $lno.0 \
734 -align center -padx 5 -pady 1 \
735 -image [mapicon $m $path]]
736 $aw insert $lno.1 "$path\n"
737 $aw conf -state disabled
738 set file_states($path) [lreplace $s $ai $ai [list $ico]]
739 } elseif {[mapicon $m $path] != [mapicon $old_m $path]} {
740 set ico [lindex $d 0]
741 $aw image conf $ico -image [mapicon $m $path]
745 proc with_update_index {body} {
746 global update_index_fd
748 if {$update_index_fd == {}} {
749 if {![lock_index update]} return
750 set update_index_fd [open \
751 "| git update-index --add --remove -z --stdin" \
753 fconfigure $update_index_fd -translation binary
755 close $update_index_fd
756 set update_index_fd {}
763 proc update_index {path} {
764 global update_index_fd
766 if {$update_index_fd == {}} {
767 error {not in with_update_index}
769 puts -nonewline $update_index_fd "$path\0"
773 proc toggle_mode {path} {
774 global file_states ui_fname_value
776 set s $file_states($path)
789 with_update_index {update_index $path}
790 display_file $path $new
791 if {$ui_fname_value == $path} {
796 ######################################################################
798 ## config (fetch push pull)
800 proc load_all_remotes {} {
801 global gitdir all_remotes
803 set all_remotes [list]
804 set rm_dir [file join $gitdir remotes]
805 if {[file isdirectory $rm_dir]} {
806 set all_remotes [concat $all_remotes \
807 [glob -types f -tails -directory $rm_dir * *]]
810 set fd_rc [open "| git repo-config --list" r]
811 while {[gets $fd_rc line] >= 0} {
812 if {[regexp ^remote\.(.*)\.url= $line line name]} {
813 lappend all_remotes $name
818 set all_remotes [lsort -unique $all_remotes]
821 proc populate_remote_menu {m pfx op} {
822 global gitdir all_remotes mainfont
824 foreach remote $all_remotes {
825 $m add command -label "$pfx $remote..." \
826 -command [list $op $remote] \
831 ######################################################################
836 #define mask_width 14
837 #define mask_height 15
838 static unsigned char mask_bits[] = {
839 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
840 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
841 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
844 image create bitmap file_plain -background white -foreground black -data {
845 #define plain_width 14
846 #define plain_height 15
847 static unsigned char plain_bits[] = {
848 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
849 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
850 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
851 } -maskdata $filemask
853 image create bitmap file_mod -background white -foreground blue -data {
855 #define mod_height 15
856 static unsigned char mod_bits[] = {
857 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
858 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
859 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
860 } -maskdata $filemask
862 image create bitmap file_fulltick -background white -foreground "#007000" -data {
863 #define file_fulltick_width 14
864 #define file_fulltick_height 15
865 static unsigned char file_fulltick_bits[] = {
866 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
867 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
868 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
869 } -maskdata $filemask
871 image create bitmap file_parttick -background white -foreground "#005050" -data {
872 #define parttick_width 14
873 #define parttick_height 15
874 static unsigned char parttick_bits[] = {
875 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
876 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
877 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
878 } -maskdata $filemask
880 image create bitmap file_question -background white -foreground black -data {
881 #define file_question_width 14
882 #define file_question_height 15
883 static unsigned char file_question_bits[] = {
884 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
885 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
886 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
887 } -maskdata $filemask
889 image create bitmap file_removed -background white -foreground red -data {
890 #define file_removed_width 14
891 #define file_removed_height 15
892 static unsigned char file_removed_bits[] = {
893 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
894 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
895 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
896 } -maskdata $filemask
898 image create bitmap file_merge -background white -foreground blue -data {
899 #define file_merge_width 14
900 #define file_merge_height 15
901 static unsigned char file_merge_bits[] = {
902 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
903 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
904 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
905 } -maskdata $filemask
907 set max_status_desc 0
909 {__ i plain "Unmodified"}
910 {_M i mod "Modified"}
911 {M_ i fulltick "Checked in"}
912 {MM i parttick "Partially checked in"}
914 {_O o plain "Untracked"}
915 {A_ o fulltick "Added"}
916 {AM o parttick "Partially added"}
917 {AD o question "Added (but now gone)"}
919 {_D i question "Missing"}
920 {D_ i removed "Removed"}
921 {DD i removed "Removed"}
922 {DO i removed "Removed (still exists)"}
924 {UM i merge "Merge conflicts"}
925 {U_ i merge "Merge conflicts"}
927 if {$max_status_desc < [string length [lindex $i 3]]} {
928 set max_status_desc [string length [lindex $i 3]]
930 set all_cols([lindex $i 0]) [lindex $i 1]
931 set all_icons([lindex $i 0]) file_[lindex $i 2]
932 set all_descs([lindex $i 0]) [lindex $i 3]
936 ######################################################################
940 proc error_popup {msg} {
947 proc show_msg {w top msg} {
948 global gitdir appname
950 message $w.m -text $msg -justify left -aspect 400
951 pack $w.m -side top -fill x -padx 5 -pady 10
952 button $w.ok -text OK \
955 -command "destroy $top"
956 pack $w.ok -side bottom
957 bind $top <Visibility> "grab $top; focus $top"
958 bind $top <Key-Return> "destroy $top"
959 wm title $top "error: $appname ([file normalize [file dirname $gitdir]])"
963 proc hook_failed_popup {hook msg} {
964 global gitdir mainfont difffont appname
971 label $w.m.l1 -text "$hook hook failed:" \
974 -font [concat $mainfont bold]
976 -background white -borderwidth 1 \
978 -width 80 -height 10 \
980 -yscrollcommand [list $w.m.sby set]
982 -text {You must correct the above errors before committing.} \
985 -font [concat $mainfont bold]
986 scrollbar $w.m.sby -command [list $w.m.t yview]
987 pack $w.m.l1 -side top -fill x
988 pack $w.m.l2 -side bottom -fill x
989 pack $w.m.sby -side right -fill y
990 pack $w.m.t -side left -fill both -expand 1
991 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
993 $w.m.t insert 1.0 $msg
994 $w.m.t conf -state disabled
996 button $w.ok -text OK \
999 -command "destroy $w"
1000 pack $w.ok -side bottom
1002 bind $w <Visibility> "grab $w; focus $w"
1003 bind $w <Key-Return> "destroy $w"
1004 wm title $w "error: $appname ([file normalize [file dirname $gitdir]])"
1008 set next_console_id 0
1010 proc new_console {short_title long_title} {
1011 global next_console_id gitdir appname mainfont difffont
1013 set w .console[incr next_console_id]
1016 label $w.m.l1 -text "$long_title:" \
1019 -font [concat $mainfont bold]
1021 -background white -borderwidth 1 \
1023 -width 80 -height 10 \
1026 -yscrollcommand [list $w.m.sby set]
1027 scrollbar $w.m.sby -command [list $w.m.t yview]
1028 pack $w.m.l1 -side top -fill x
1029 pack $w.m.sby -side right -fill y
1030 pack $w.m.t -side left -fill both -expand 1
1031 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1033 button $w.ok -text {OK} \
1037 -command "destroy $w"
1038 pack $w.ok -side bottom
1040 bind $w <Visibility> "focus $w"
1041 bind $w <Destroy> break
1042 wm title $w "$appname ([file dirname [file normalize [file dirname $gitdir]]]): $short_title"
1046 proc console_read {w fd} {
1047 $w.m.t conf -state normal
1048 while {[gets $fd line] >= 0} {
1049 $w.m.t insert end $line
1050 $w.m.t insert end "\n"
1052 $w.m.t conf -state disabled
1056 $w.ok conf -state normal
1060 ######################################################################
1064 set starting_gitk_msg {Please wait... Starting gitk...}
1066 global tcl_platform ui_status_value starting_gitk_msg
1068 set ui_status_value $starting_gitk_msg
1070 if {$ui_status_value == $starting_gitk_msg} {
1071 set ui_status_value {Ready.}
1075 if {$tcl_platform(platform) == "windows"} {
1083 global gitdir ui_comm
1085 set save [file join $gitdir GITGUI_MSG]
1086 set msg [string trim [$ui_comm get 0.0 end]]
1087 if {[$ui_comm edit modified] && $msg != {}} {
1089 set fd [open $save w]
1090 puts $fd [string trim [$ui_comm get 0.0 end]]
1093 } elseif {$msg == {} && [file exists $save]} {
1104 proc do_checkin_all {} {
1105 global checkin_active ui_status_value
1107 if {$checkin_active || ![lock_index begin-update]} return
1109 set checkin_active 1
1110 set ui_status_value {Checking in all files...}
1113 foreach path [array names file_states] {
1114 set s $file_states($path)
1120 _D {toggle_mode $path}
1124 set checkin_active 0
1125 set ui_status_value {Ready.}
1129 proc do_signoff {} {
1133 set me [exec git var GIT_COMMITTER_IDENT]
1134 if {[regexp {(.*) [0-9]+ [-+0-9]+$} $me me name]} {
1135 set str "Signed-off-by: $name"
1136 if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1137 $ui_comm insert end "\n"
1138 $ui_comm insert end $str
1145 proc do_amend_last {} {
1153 # shift == 1: left click
1155 proc click {w x y shift wx wy} {
1156 global ui_index ui_other
1158 set pos [split [$w index @$x,$y] .]
1159 set lno [lindex $pos 0]
1160 set col [lindex $pos 1]
1161 set path [$w get $lno.1 $lno.end]
1162 if {$path == {}} return
1164 if {$col > 0 && $shift == 1} {
1165 $ui_index tag remove in_diff 0.0 end
1166 $ui_other tag remove in_diff 0.0 end
1167 $w tag add in_diff $lno.0 [expr $lno + 1].0
1172 proc unclick {w x y} {
1173 set pos [split [$w index @$x,$y] .]
1174 set lno [lindex $pos 0]
1175 set col [lindex $pos 1]
1176 set path [$w get $lno.1 $lno.end]
1177 if {$path == {}} return
1184 ######################################################################
1188 set mainfont {Helvetica 10}
1189 set difffont {Courier 10}
1190 set maincursor [. cget -cursor]
1192 switch -- $tcl_platform(platform) {
1193 windows {set M1B Control; set M1T Ctrl}
1194 default {set M1B M1; set M1T M1}
1198 menu .mbar -tearoff 0
1199 .mbar add cascade -label Project -menu .mbar.project
1200 .mbar add cascade -label Commit -menu .mbar.commit
1201 .mbar add cascade -label Fetch -menu .mbar.fetch
1202 .mbar add cascade -label Pull -menu .mbar.pull
1203 .mbar add cascade -label Push -menu .mbar.push
1204 . configure -menu .mbar
1208 .mbar.project add command -label Visualize \
1211 .mbar.project add command -label Quit \
1213 -accelerator $M1T-Q \
1218 .mbar.commit add command -label Rescan \
1219 -command do_rescan \
1222 lappend disable_on_lock \
1223 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1224 .mbar.commit add command -label {Amend Last Commit} \
1225 -command do_amend_last \
1227 lappend disable_on_lock \
1228 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1229 .mbar.commit add command -label {Check-in All Files} \
1230 -command do_checkin_all \
1231 -accelerator $M1T-U \
1233 lappend disable_on_lock \
1234 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1235 .mbar.commit add command -label {Sign Off} \
1236 -command do_signoff \
1237 -accelerator $M1T-S \
1239 .mbar.commit add command -label Commit \
1240 -command do_commit \
1241 -accelerator $M1T-Return \
1243 lappend disable_on_lock \
1244 [list .mbar.commit entryconf [.mbar.commit index last] -state]
1255 # -- Main Window Layout
1256 panedwindow .vpane -orient vertical
1257 panedwindow .vpane.files -orient horizontal
1258 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1259 pack .vpane -anchor n -side top -fill both -expand 1
1261 # -- Index File List
1262 set ui_index .vpane.files.index.list
1263 frame .vpane.files.index -height 100 -width 400
1264 label .vpane.files.index.title -text {Modified Files} \
1267 text $ui_index -background white -borderwidth 0 \
1268 -width 40 -height 10 \
1270 -yscrollcommand {.vpane.files.index.sb set} \
1271 -cursor $maincursor \
1273 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1274 pack .vpane.files.index.title -side top -fill x
1275 pack .vpane.files.index.sb -side right -fill y
1276 pack $ui_index -side left -fill both -expand 1
1277 .vpane.files add .vpane.files.index -sticky nsew
1279 # -- Other (Add) File List
1280 set ui_other .vpane.files.other.list
1281 frame .vpane.files.other -height 100 -width 100
1282 label .vpane.files.other.title -text {Untracked Files} \
1285 text $ui_other -background white -borderwidth 0 \
1286 -width 40 -height 10 \
1288 -yscrollcommand {.vpane.files.other.sb set} \
1289 -cursor $maincursor \
1291 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1292 pack .vpane.files.other.title -side top -fill x
1293 pack .vpane.files.other.sb -side right -fill y
1294 pack $ui_other -side left -fill both -expand 1
1295 .vpane.files add .vpane.files.other -sticky nsew
1297 $ui_index tag conf in_diff -font [concat $mainfont bold]
1298 $ui_other tag conf in_diff -font [concat $mainfont bold]
1301 set ui_fname_value {}
1302 set ui_fstatus_value {}
1303 frame .vpane.diff -height 200 -width 400
1304 frame .vpane.diff.header
1305 label .vpane.diff.header.l1 -text {File:} -font $mainfont
1306 label .vpane.diff.header.l2 -textvariable ui_fname_value \
1310 label .vpane.diff.header.l3 -text {Status:} -font $mainfont
1311 label .vpane.diff.header.l4 -textvariable ui_fstatus_value \
1312 -width $max_status_desc \
1316 pack .vpane.diff.header.l1 -side left
1317 pack .vpane.diff.header.l2 -side left -fill x
1318 pack .vpane.diff.header.l4 -side right
1319 pack .vpane.diff.header.l3 -side right
1322 frame .vpane.diff.body
1323 set ui_diff .vpane.diff.body.t
1324 text $ui_diff -background white -borderwidth 0 \
1325 -width 80 -height 15 -wrap none \
1327 -xscrollcommand {.vpane.diff.body.sbx set} \
1328 -yscrollcommand {.vpane.diff.body.sby set} \
1329 -cursor $maincursor \
1331 scrollbar .vpane.diff.body.sbx -orient horizontal \
1332 -command [list $ui_diff xview]
1333 scrollbar .vpane.diff.body.sby -orient vertical \
1334 -command [list $ui_diff yview]
1335 pack .vpane.diff.body.sbx -side bottom -fill x
1336 pack .vpane.diff.body.sby -side right -fill y
1337 pack $ui_diff -side left -fill both -expand 1
1338 pack .vpane.diff.header -side top -fill x
1339 pack .vpane.diff.body -side bottom -fill both -expand 1
1340 .vpane add .vpane.diff -stick nsew
1342 $ui_diff tag conf dm -foreground red
1343 $ui_diff tag conf dp -foreground blue
1344 $ui_diff tag conf da -font [concat $difffont bold]
1345 $ui_diff tag conf di -foreground "#00a000"
1346 $ui_diff tag conf dni -foreground "#a000a0"
1347 $ui_diff tag conf bold -font [concat $difffont bold]
1350 frame .vpane.commarea -height 170
1351 .vpane add .vpane.commarea -stick nsew
1353 # -- Commit Area Buttons
1354 frame .vpane.commarea.buttons
1355 label .vpane.commarea.buttons.l -text {} \
1359 pack .vpane.commarea.buttons.l -side top -fill x
1360 pack .vpane.commarea.buttons -side left -fill y
1362 button .vpane.commarea.buttons.rescan -text {Rescan} \
1363 -command do_rescan \
1365 pack .vpane.commarea.buttons.rescan -side top -fill x
1366 lappend disable_on_lock {.vpane.commarea.buttons.rescan conf -state}
1368 button .vpane.commarea.buttons.amend -text {Amend Last} \
1369 -command do_amend_last \
1371 pack .vpane.commarea.buttons.amend -side top -fill x
1372 lappend disable_on_lock {.vpane.commarea.buttons.amend conf -state}
1374 button .vpane.commarea.buttons.ciall -text {Check-in All} \
1375 -command do_checkin_all \
1377 pack .vpane.commarea.buttons.ciall -side top -fill x
1378 lappend disable_on_lock {.vpane.commarea.buttons.ciall conf -state}
1380 button .vpane.commarea.buttons.signoff -text {Sign Off} \
1381 -command do_signoff \
1383 pack .vpane.commarea.buttons.signoff -side top -fill x
1385 button .vpane.commarea.buttons.commit -text {Commit} \
1386 -command do_commit \
1388 pack .vpane.commarea.buttons.commit -side top -fill x
1389 lappend disable_on_lock {.vpane.commarea.buttons.commit conf -state}
1391 # -- Commit Message Buffer
1392 frame .vpane.commarea.buffer
1393 set ui_comm .vpane.commarea.buffer.t
1394 set ui_coml .vpane.commarea.buffer.l
1395 label $ui_coml -text {Commit Message:} \
1399 trace add variable commit_type write {uplevel #0 {
1400 switch -glob $commit_type \
1401 initial {$ui_coml conf -text {Initial Commit Message:}} \
1402 amend {$ui_coml conf -text {Amended Commit Message:}} \
1403 merge {$ui_coml conf -text {Merge Commit Message:}} \
1404 * {$ui_coml conf -text {Commit Message:}}
1406 text $ui_comm -background white -borderwidth 1 \
1408 -width 75 -height 10 -wrap none \
1410 -yscrollcommand {.vpane.commarea.buffer.sby set} \
1412 scrollbar .vpane.commarea.buffer.sby -command [list $ui_comm yview]
1413 pack $ui_coml -side top -fill x
1414 pack .vpane.commarea.buffer.sby -side right -fill y
1415 pack $ui_comm -side left -fill y
1416 pack .vpane.commarea.buffer -side left -fill y
1419 set ui_status_value {Initializing...}
1420 label .status -textvariable ui_status_value \
1426 pack .status -anchor w -side bottom -fill x
1429 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1430 bind . <Destroy> do_quit
1431 bind . <Key-F5> do_rescan
1432 bind . <$M1B-Key-r> do_rescan
1433 bind . <$M1B-Key-R> do_rescan
1434 bind . <$M1B-Key-s> do_signoff
1435 bind . <$M1B-Key-S> do_signoff
1436 bind . <$M1B-Key-u> do_checkin_all
1437 bind . <$M1B-Key-U> do_checkin_all
1438 bind . <$M1B-Key-Return> do_commit
1439 bind . <$M1B-Key-q> do_quit
1440 bind . <$M1B-Key-Q> do_quit
1441 foreach i [list $ui_index $ui_other] {
1442 bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1443 bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1444 bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1448 ######################################################################
1452 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
1453 show_msg {} . "Cannot find the git directory: $err"
1456 set cdup [exec git rev-parse --show-cdup]
1462 set appname [lindex [file split $argv0] end]
1463 if {$appname == {git-citool}} {
1467 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1468 focus -force $ui_comm
1470 populate_remote_menu .mbar.fetch From fetch_from
1471 populate_remote_menu .mbar.push To push_to