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
114 global buf_rdi buf_rdf buf_rlo
117 if {![eof
$fd]} return
120 set ls_others
[list | git ls-files
--others -z \
121 --exclude-per-directory=.gitignore
]
122 set info_exclude
[file join $gitdir info exclude
]
123 if {[file readable
$info_exclude]} {
124 lappend ls_others
"--exclude-from=$info_exclude"
132 set ui_status_value
{Scanning
for modified files ...
}
133 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
134 set fd_df
[open
"| git diff-files -z" r
]
135 set fd_lo
[open
$ls_others r
]
137 fconfigure
$fd_di -blocking 0 -translation binary
138 fconfigure
$fd_df -blocking 0 -translation binary
139 fconfigure
$fd_lo -blocking 0 -translation binary
140 fileevent
$fd_di readable
[list read_diff_index
$fd_di $final]
141 fileevent
$fd_df readable
[list read_diff_files
$fd_df $final]
142 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $final]
145 proc load_message
{file} {
146 global gitdir ui_comm
148 set f
[file join $gitdir $file]
149 if {[file isfile
$f]} {
150 if {[catch
{set fd
[open
$f r
]}]} {
153 set content
[string trim
[read $fd]]
155 $ui_comm delete
0.0 end
156 $ui_comm insert end
$content
162 proc read_diff_index
{fd final
} {
165 append buf_rdi
[read $fd]
167 set n
[string length
$buf_rdi]
169 set z1
[string first
"\0" $buf_rdi $c]
172 set z2
[string first
"\0" $buf_rdi $z1]
178 [string range
$buf_rdi $z1 $z2] \
179 [string index
$buf_rdi [expr $z1 - 2]]_
183 set buf_rdi
[string range
$buf_rdi $c end
]
188 status_eof
$fd buf_rdi
$final
191 proc read_diff_files
{fd final
} {
194 append buf_rdf
[read $fd]
196 set n
[string length
$buf_rdf]
198 set z1
[string first
"\0" $buf_rdf $c]
201 set z2
[string first
"\0" $buf_rdf $z1]
207 [string range
$buf_rdf $z1 $z2] \
208 _
[string index
$buf_rdf [expr $z1 - 2]]
212 set buf_rdf
[string range
$buf_rdf $c end
]
217 status_eof
$fd buf_rdf
$final
220 proc read_ls_others
{fd final
} {
223 append buf_rlo
[read $fd]
224 set pck
[split $buf_rlo "\0"]
225 set buf_rlo
[lindex
$pck end
]
226 foreach p
[lrange
$pck 0 end-1
] {
229 status_eof
$fd buf_rlo
$final
232 proc status_eof
{fd buf final
} {
233 global status_active
$buf
234 global ui_fname_value ui_status_value file_states
240 if {[incr status_active
-1] == 0} {
244 set ui_status_value
$final
246 if {$ui_fname_value != {} && [array names file_states \
247 -exact $ui_fname_value] != {}} {
248 show_diff
$ui_fname_value
256 ######################################################################
261 global ui_diff ui_fname_value ui_fstatus_value
263 $ui_diff conf
-state normal
264 $ui_diff delete
0.0 end
265 $ui_diff conf
-state disabled
266 set ui_fname_value
{}
267 set ui_fstatus_value
{}
270 proc show_diff
{path
} {
271 global file_states PARENT diff_3way diff_active
272 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
274 if {$diff_active ||
![lock_index
read]} return
277 set s
$file_states($path)
281 set ui_fname_value
$path
282 set ui_fstatus_value
[mapdesc
$m $path]
283 set ui_status_value
"Loading diff of $path..."
285 set cmd
[list | git diff-index
-p $PARENT -- $path]
290 set cmd
[list | git diff-index
-p -c $PARENT $path]
294 set fd
[open
$path r
]
295 set content
[read $fd]
300 set ui_status_value
"Unable to display $path"
301 error_popup
"Error loading file:\n$err"
304 $ui_diff conf
-state normal
305 $ui_diff insert end
$content
306 $ui_diff conf
-state disabled
309 set ui_status_value
{Ready.
}
314 if {[catch
{set fd
[open
$cmd r
]} err
]} {
317 set ui_status_value
"Unable to display $path"
318 error_popup
"Error loading diff:\n$err"
322 fconfigure
$fd -blocking 0 -translation auto
323 fileevent
$fd readable
[list read_diff
$fd]
326 proc read_diff
{fd
} {
327 global ui_diff ui_status_value diff_3way diff_active
329 while {[gets
$fd line
] >= 0} {
330 if {[string match
{diff --git *} $line]} continue
331 if {[string match
{diff --combined *} $line]} continue
332 if {[string match
{--- *} $line]} continue
333 if {[string match
{+++ *} $line]} continue
334 if {[string match index
* $line]} {
335 if {[string first
, $line] >= 0} {
340 $ui_diff conf
-state normal
342 set x
[string index
$line 0]
347 default
{set tags
{}}
350 set x
[string range
$line 0 1]
352 default
{set tags
{}}
354 "++" {set tags dp
; set x
" +"}
355 " +" {set tags
{di bold
}; set x
"++"}
356 "+ " {set tags dni
; set x
"-+"}
357 "--" {set tags dm
; set x
" -"}
358 " -" {set tags
{dm bold
}; set x
"--"}
359 "- " {set tags di
; set x
"+-"}
360 default
{set tags
{}}
362 set line
[string replace
$line 0 1 $x]
364 $ui_diff insert end
$line $tags
365 $ui_diff insert end
"\n"
366 $ui_diff conf
-state disabled
373 set ui_status_value
{Ready.
}
377 ######################################################################
381 proc load_last_commit
{} {
382 global HEAD PARENT commit_type ui_comm
384 if {$commit_type == {amend
}} return
385 if {$commit_type != {normal
}} {
386 error_popup
"Can't amend a $commit_type commit."
394 set fd
[open
"| git cat-file commit $HEAD" r
]
395 while {[gets
$fd line
] > 0} {
396 if {[string match
{parent
*} $line]} {
397 set parent
[string range
$line 7 end
]
401 set msg
[string trim
[read $fd]]
404 error_popup
"Error loading commit data for amend:\n$err"
408 if {$parent_count == 0} {
409 set commit_type amend
413 } elseif
{$parent_count == 1} {
414 set commit_type amend
416 $ui_comm delete
0.0 end
417 $ui_comm insert end
$msg
418 $ui_comm edit modified false
421 error_popup
{You can
't amend a merge commit.}
426 proc commit_tree {} {
427 global tcl_platform HEAD gitdir commit_type file_states
428 global commit_active ui_status_value
431 if {$commit_active || ![lock_index update]} return
433 # -- Our in memory state should match the repository.
435 repository_state curHEAD cur_type
436 if {$commit_type == {amend}
437 && $cur_type == {normal}
438 && $curHEAD == $HEAD} {
439 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
440 error_popup {Last scanned state does not match repository state.
442 Its highly likely that another Git program modified the
443 repository since our last scan. A rescan is required
451 # -- At least one file should differ in the index.
454 foreach path [array names file_states] {
455 set s $file_states($path)
456 switch -glob -- [lindex $s 0] {
460 M* {set files_ready 1; break}
462 error_popup "Unmerged files cannot be committed.
464 File $path has merge conflicts.
465 You must resolve them and check the file in before committing.
471 error_popup "Unknown file state [lindex $s 0] detected.
473 File $path cannot be committed by this program.
479 error_popup {No checked-in files to commit.
481 You must check-in at least 1 file before you can commit.
487 # -- A message is required.
489 set msg [string trim [$ui_comm get 1.0 end]]
491 error_popup {Please supply a commit message.
493 A good commit message has the following format:
495 - First line: Describe in one sentance what you did.
497 - Remaining lines: Describe why this change is good.
503 # -- Ask the pre-commit hook for the go-ahead.
505 set pchook [file join $gitdir hooks pre-commit]
506 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
507 set pchook [list sh -c \
508 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
509 } elseif {[file executable $pchook]} {
510 set pchook [list $pchook]
514 if {$pchook != {} && [catch {eval exec $pchook} err]} {
515 hook_failed_popup pre-commit $err
520 # -- Write the tree in the background.
523 set ui_status_value {Committing changes...}
525 set fd_wt [open "| git write-tree" r]
526 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
529 proc commit_stage2 {fd_wt curHEAD msg} {
530 global single_commit gitdir PARENT commit_type
531 global commit_active ui_status_value ui_comm
536 if {$tree_id == {}} {
537 error_popup "write-tree failed"
539 set ui_status_value {Commit failed.}
544 # -- Create the commit.
546 set cmd [list git commit-tree $tree_id]
548 lappend cmd -p $PARENT
550 if {$commit_type == {merge}} {
552 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
553 while {[gets $fd_mh merge_head] >= 0} {
554 lappend cmd -p $merge_head
558 error_popup "Loading MERGE_HEADs failed:\n$err"
560 set ui_status_value {Commit failed.}
566 # git commit-tree writes to stderr during initial commit.
567 lappend cmd 2>/dev/null
570 if {[catch {set cmt_id [eval exec $cmd]} err]} {
571 error_popup "commit-tree failed:\n$err"
573 set ui_status_value {Commit failed.}
578 # -- Update the HEAD ref.
581 if {$commit_type != {normal}} {
582 append reflogm " ($commit_type)"
584 set i [string first "\n" $msg]
586 append reflogm {: } [string range $msg 0 [expr $i - 1]]
588 append reflogm {: } $msg
590 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
591 if {[catch {eval exec $cmd} err]} {
592 error_popup "update-ref failed:\n$err"
594 set ui_status_value {Commit failed.}
599 # -- Cleanup after ourselves.
601 catch {file delete [file join $gitdir MERGE_HEAD]}
602 catch {file delete [file join $gitdir MERGE_MSG]}
603 catch {file delete [file join $gitdir SQUASH_MSG]}
604 catch {file delete [file join $gitdir GITGUI_MSG]}
606 # -- Let rerere do its thing.
608 if {[file isdirectory [file join $gitdir rr-cache]]} {
609 catch {exec git rerere}
612 $ui_comm delete 0.0 end
613 $ui_comm edit modified false
615 if {$single_commit} do_quit
622 update_status "Changes committed as $cmt_id."
625 ######################################################################
629 proc fetch_from {remote} {
630 set w [new_console "fetch $remote" \
631 "Fetching new changes from $remote"]
632 set cmd [list git fetch]
637 proc pull_remote {remote branch} {
638 set w [new_console "pull $remote $branch" \
639 "Pulling new changes from branch $branch in $remote"]
640 set cmd [list git pull]
643 console_exec $w $cmd [list post_pull_remote $remote $branch]
646 proc post_pull_remote {remote branch success} {
648 update_status "Successfully pulled $branch from $remote."
650 update_status "Conflicts detected while pulling $branch from $remote."
654 proc push_to {remote} {
655 set w [new_console "push $remote" \
656 "Pushing changes to $remote"]
657 set cmd [list git push]
662 ######################################################################
666 proc mapcol {state path} {
667 global all_cols ui_other
669 if {[catch {set r $all_cols($state)}]} {
670 puts "error: no column for state={$state} $path"
676 proc mapicon {state path} {
679 if {[catch {set r $all_icons($state)}]} {
680 puts "error: no icon for state={$state} $path"
686 proc mapdesc {state path} {
689 if {[catch {set r $all_descs($state)}]} {
690 puts "error: no desc for state={$state} $path"
696 proc bsearch {w path} {
697 set hi [expr [lindex [split [$w index end] .] 0] - 2]
703 set mi [expr [expr $lo + $hi] / 2]
704 set ti [expr $mi + 1]
705 set cmp [string compare [$w get $ti.1 $ti.end] $path]
708 } elseif {$cmp == 0} {
714 return -[expr $lo + 1]
719 proc merge_state {path new_state} {
720 global file_states next_icon_id
722 set s0 [string index $new_state 0]
723 set s1 [string index $new_state 1]
725 if {[catch {set info $file_states($path)}]} {
727 set icon n[incr next_icon_id]
729 set state [lindex $info 0]
730 set icon [lindex $info 1]
734 set s0 [string index $state 0]
735 } elseif {$s0 == {*}} {
740 set s1 [string index $state 1]
741 } elseif {$s1 == {*}} {
745 set file_states($path) [list $s0$s1 $icon]
749 proc display_file {path state} {
750 global ui_index ui_other file_states status_active
752 set old_m [merge_state $path $state]
753 if {$status_active} return
755 set s $file_states($path)
756 set new_m [lindex $s 0]
757 set new_w [mapcol $new_m $path]
758 set old_w [mapcol $old_m $path]
759 set new_icon [mapicon $new_m $path]
761 if {$new_w != $old_w} {
762 set lno [bsearch $old_w $path]
765 $old_w conf -state normal
766 $old_w delete $lno.0 [expr $lno + 1].0
767 $old_w conf -state disabled
770 set lno [expr abs([bsearch $new_w $path] + 1) + 1]
771 $new_w conf -state normal
772 $new_w image create $lno.0 \
773 -align center -padx 5 -pady 1 \
774 -name [lindex $s 1] \
775 -image [mapicon $m $path]
776 $new_w insert $lno.1 "$path\n"
777 $new_w conf -state disabled
778 } elseif {$new_icon != [mapicon $old_m $path]} {
779 $new_w conf -state normal
780 $new_w image conf [lindex $s 1] -image $new_icon
781 $new_w conf -state disabled
785 proc display_all_files {} {
786 global ui_index ui_other file_states
788 $ui_index conf -state normal
789 $ui_other conf -state normal
791 foreach path [lsort [array names file_states]] {
792 set s $file_states($path)
794 set w [mapcol $m $path]
795 $w image create end \
796 -align center -padx 5 -pady 1 \
797 -name [lindex $s 1] \
798 -image [mapicon $m $path]
799 $w insert end "$path\n"
802 $ui_index conf -state disabled
803 $ui_other conf -state disabled
806 proc with_update_index {body} {
807 global update_index_fd
809 if {$update_index_fd == {}} {
810 if {![lock_index update]} return
811 set update_index_fd [open \
812 "| git update-index --add --remove -z --stdin" \
814 fconfigure $update_index_fd -translation binary
816 close $update_index_fd
817 set update_index_fd {}
824 proc update_index {path} {
825 global update_index_fd
827 if {$update_index_fd == {}} {
828 error {not in with_update_index}
830 puts -nonewline $update_index_fd "$path\0"
834 proc toggle_mode {path} {
835 global file_states ui_fname_value
837 set s $file_states($path)
850 with_update_index {update_index $path}
851 display_file $path $new
852 if {$ui_fname_value == $path} {
857 ######################################################################
859 ## config (fetch push pull)
861 proc load_repo_config {} {
864 array unset repo_config
866 set fd_rc [open "| git repo-config --list" r]
867 while {[gets $fd_rc line] >= 0} {
868 if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
869 lappend repo_config($name) $value
876 proc load_all_remotes {} {
877 global gitdir all_remotes repo_config
879 set all_remotes [list]
880 set rm_dir [file join $gitdir remotes]
881 if {[file isdirectory $rm_dir]} {
882 set all_remotes [concat $all_remotes [glob \
886 -directory $rm_dir *]]
889 foreach line [array names repo_config remote.*.url] {
890 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
891 lappend all_remotes $name
895 set all_remotes [lsort -unique $all_remotes]
898 proc populate_remote_menu {m pfx op} {
899 global all_remotes mainfont
901 foreach remote $all_remotes {
902 $m add command -label "$pfx $remote..." \
903 -command [list $op $remote] \
908 proc populate_pull_menu {m} {
909 global gitdir repo_config all_remotes mainfont
911 foreach remote $all_remotes {
913 if {[array get repo_config remote.$remote.url] != {}} {
914 if {[array get repo_config remote.$remote.fetch] != {}} {
916 [lindex $repo_config(remote.$remote.fetch) 0] \
921 set fd [open [file join $gitdir remotes $remote] r]
922 while {[gets $fd line] >= 0} {
923 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
932 regsub ^refs/heads/ $rb {} rb_short
933 if {$rb_short != {}} {
935 -label "Branch $rb_short from $remote..." \
936 -command [list pull_remote $remote $rb] \
942 ######################################################################
947 #define mask_width 14
948 #define mask_height 15
949 static unsigned char mask_bits[] = {
950 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
951 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
952 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
955 image create bitmap file_plain -background white -foreground black -data {
956 #define plain_width 14
957 #define plain_height 15
958 static unsigned char plain_bits[] = {
959 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
960 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
961 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
962 } -maskdata $filemask
964 image create bitmap file_mod -background white -foreground blue -data {
966 #define mod_height 15
967 static unsigned char mod_bits[] = {
968 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
969 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
970 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
971 } -maskdata $filemask
973 image create bitmap file_fulltick -background white -foreground "#007000" -data {
974 #define file_fulltick_width 14
975 #define file_fulltick_height 15
976 static unsigned char file_fulltick_bits[] = {
977 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
978 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
979 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
980 } -maskdata $filemask
982 image create bitmap file_parttick -background white -foreground "#005050" -data {
983 #define parttick_width 14
984 #define parttick_height 15
985 static unsigned char parttick_bits[] = {
986 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
987 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
988 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
989 } -maskdata $filemask
991 image create bitmap file_question -background white -foreground black -data {
992 #define file_question_width 14
993 #define file_question_height 15
994 static unsigned char file_question_bits[] = {
995 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
996 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
997 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
998 } -maskdata $filemask
1000 image create bitmap file_removed -background white -foreground red -data {
1001 #define file_removed_width 14
1002 #define file_removed_height 15
1003 static unsigned char file_removed_bits[] = {
1004 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1005 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1006 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1007 } -maskdata $filemask
1009 image create bitmap file_merge -background white -foreground blue -data {
1010 #define file_merge_width 14
1011 #define file_merge_height 15
1012 static unsigned char file_merge_bits[] = {
1013 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1014 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1015 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1016 } -maskdata $filemask
1018 set ui_index .vpane.files.index.list
1019 set ui_other .vpane.files.other.list
1020 set max_status_desc 0
1022 {__ i plain "Unmodified"}
1023 {_M i mod "Modified"}
1024 {M_ i fulltick "Checked in"}
1025 {MM i parttick "Partially checked in"}
1027 {_O o plain "Untracked"}
1028 {A_ o fulltick "Added"}
1029 {AM o parttick "Partially added"}
1030 {AD o question "Added (but now gone)"}
1032 {_D i question "Missing"}
1033 {D_ i removed "Removed"}
1034 {DD i removed "Removed"}
1035 {DO i removed "Removed (still exists)"}
1037 {UM i merge "Merge conflicts"}
1038 {U_ i merge "Merge conflicts"}
1040 if {$max_status_desc < [string length [lindex $i 3]]} {
1041 set max_status_desc [string length [lindex $i 3]]
1043 if {[lindex $i 1] == {i}} {
1044 set all_cols([lindex $i 0]) $ui_index
1046 set all_cols([lindex $i 0]) $ui_other
1048 set all_icons([lindex $i 0]) file_[lindex $i 2]
1049 set all_descs([lindex $i 0]) [lindex $i 3]
1053 ######################################################################
1057 proc error_popup {msg} {
1064 proc show_msg {w top msg} {
1065 global gitdir appname mainfont
1067 message $w.m -text $msg -justify left -aspect 400
1068 pack $w.m -side top -fill x -padx 5 -pady 10
1069 button $w.ok -text OK \
1072 -command "destroy $top"
1073 pack $w.ok -side bottom
1074 bind $top <Visibility> "grab $top; focus $top"
1075 bind $top <Key-Return> "destroy $top"
1076 wm title $w "$appname ([lindex [file split \
1077 [file normalize [file dirname $gitdir]]] \
1082 proc hook_failed_popup {hook msg} {
1083 global gitdir mainfont difffont appname
1090 label $w.m.l1 -text "$hook hook failed:" \
1093 -font [concat $mainfont bold]
1095 -background white -borderwidth 1 \
1097 -width 80 -height 10 \
1099 -yscrollcommand [list $w.m.sby set]
1101 -text {You must correct the above errors before committing.} \
1104 -font [concat $mainfont bold]
1105 scrollbar $w.m.sby -command [list $w.m.t yview]
1106 pack $w.m.l1 -side top -fill x
1107 pack $w.m.l2 -side bottom -fill x
1108 pack $w.m.sby -side right -fill y
1109 pack $w.m.t -side left -fill both -expand 1
1110 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1112 $w.m.t insert 1.0 $msg
1113 $w.m.t conf -state disabled
1115 button $w.ok -text OK \
1118 -command "destroy $w"
1119 pack $w.ok -side bottom
1121 bind $w <Visibility> "grab $w; focus $w"
1122 bind $w <Key-Return> "destroy $w"
1123 wm title $w "$appname ([lindex [file split \
1124 [file normalize [file dirname $gitdir]]] \
1129 set next_console_id 0
1131 proc new_console {short_title long_title} {
1132 global next_console_id console_data
1133 set w .console[incr next_console_id]
1134 set console_data($w) [list $short_title $long_title]
1135 return [console_init $w]
1138 proc console_init {w} {
1139 global console_cr console_data
1140 global gitdir appname mainfont difffont
1142 set console_cr($w) 1.0
1145 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1148 -font [concat $mainfont bold]
1150 -background white -borderwidth 1 \
1152 -width 80 -height 10 \
1155 -yscrollcommand [list $w.m.sby set]
1156 label $w.m.s -anchor w \
1158 -font [concat $mainfont bold]
1159 scrollbar $w.m.sby -command [list $w.m.t yview]
1160 pack $w.m.l1 -side top -fill x
1161 pack $w.m.s -side bottom -fill x
1162 pack $w.m.sby -side right -fill y
1163 pack $w.m.t -side left -fill both -expand 1
1164 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1166 button $w.ok -text {Running...} \
1170 -command "destroy $w"
1171 pack $w.ok -side bottom
1173 bind $w <Visibility> "focus $w"
1174 wm title $w "$appname ([lindex [file split \
1175 [file normalize [file dirname $gitdir]]] \
1176 end]): [lindex $console_data($w) 0]"
1180 proc console_exec {w cmd {after {}}} {
1183 # -- Windows tosses the enviroment when we exec our child.
1184 # But most users need that so we have to relogin. :-(
1186 if {$tcl_platform(platform) == {windows}} {
1187 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1190 # -- Tcl won't
let us redirect both stdout and stderr to
1191 # the same pipe. So pass it through cat...
1193 set cmd
[concat |
$cmd |
& cat]
1195 set fd_f
[open
$cmd r
]
1196 fconfigure
$fd_f -blocking 0 -translation binary
1197 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1200 proc console_read
{w fd after
} {
1201 global console_cr console_data
1205 if {![winfo exists
$w]} {console_init
$w}
1206 $w.m.t conf
-state normal
1208 set n
[string length
$buf]
1210 set cr
[string first
"\r" $buf $c]
1211 set lf
[string first
"\n" $buf $c]
1212 if {$cr < 0} {set cr
[expr $n + 1]}
1213 if {$lf < 0} {set lf
[expr $n + 1]}
1216 $w.m.t insert end
[string range
$buf $c $lf]
1217 set console_cr
($w) [$w.m.t index
{end
-1c}]
1221 $w.m.t delete
$console_cr($w) end
1222 $w.m.t insert end
"\n"
1223 $w.m.t insert end
[string range
$buf $c $cr]
1228 $w.m.t conf
-state disabled
1232 fconfigure
$fd -blocking 1
1234 if {[catch
{close
$fd}]} {
1235 if {![winfo exists
$w]} {console_init
$w}
1236 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1237 $w.ok conf
-text Close
1238 $w.ok conf
-state normal
1240 } elseif
{[winfo exists
$w]} {
1241 $w.m.s conf
-background green
-text {Success
}
1242 $w.ok conf
-text Close
1243 $w.ok conf
-state normal
1246 array
unset console_cr
$w
1247 array
unset console_data
$w
1249 uplevel
#0 $after $ok
1253 fconfigure
$fd -blocking 0
1256 ######################################################################
1260 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1263 global tcl_platform ui_status_value starting_gitk_msg
1265 set ui_status_value
$starting_gitk_msg
1267 if {$ui_status_value == $starting_gitk_msg} {
1268 set ui_status_value
{Ready.
}
1272 if {$tcl_platform(platform
) == {windows
}} {
1280 set w
[new_console
"repack" "Repacking the object database"]
1281 set cmd
[list git repack
]
1284 console_exec
$w $cmd
1288 global gitdir ui_comm
1290 set save
[file join $gitdir GITGUI_MSG
]
1291 set msg
[string trim
[$ui_comm get
0.0 end
]]
1292 if {[$ui_comm edit modified
] && $msg != {}} {
1294 set fd
[open
$save w
]
1295 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1298 } elseif
{$msg == {} && [file exists
$save]} {
1309 proc do_checkin_all
{} {
1310 global checkin_active ui_status_value
1312 if {$checkin_active ||
![lock_index begin-update
]} return
1314 set checkin_active
1
1315 set ui_status_value
{Checking
in all files...
}
1318 foreach path
[array names file_states
] {
1319 set s
$file_states($path)
1325 _D
{toggle_mode
$path}
1329 set checkin_active
0
1330 set ui_status_value
{Ready.
}
1334 proc do_signoff
{} {
1338 set me
[exec git var GIT_COMMITTER_IDENT
]
1339 if {[regexp
{(.
*) [0-9]+ [-+0-9]+$
} $me me name
]} {
1340 set str
"Signed-off-by: $name"
1341 if {[$ui_comm get
{end
-1c linestart
} {end
-1c}] != $str} {
1342 $ui_comm insert end
"\n"
1343 $ui_comm insert end
$str
1350 proc do_amend_last
{} {
1358 # shift == 1: left click
1360 proc click
{w x y
shift wx wy
} {
1361 global ui_index ui_other
1363 set pos
[split [$w index @
$x,$y] .
]
1364 set lno
[lindex
$pos 0]
1365 set col [lindex
$pos 1]
1366 set path
[$w get
$lno.1 $lno.end
]
1367 if {$path == {}} return
1369 if {$col > 0 && $shift == 1} {
1370 $ui_index tag remove in_diff
0.0 end
1371 $ui_other tag remove in_diff
0.0 end
1372 $w tag add in_diff
$lno.0 [expr $lno + 1].0
1377 proc unclick
{w x y
} {
1378 set pos
[split [$w index @
$x,$y] .
]
1379 set lno
[lindex
$pos 0]
1380 set col [lindex
$pos 1]
1381 set path
[$w get
$lno.1 $lno.end
]
1382 if {$path == {}} return
1389 ######################################################################
1393 set mainfont
{Helvetica
10}
1394 set difffont
{Courier
10}
1395 set maincursor
[. cget
-cursor]
1397 switch
-glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1398 windows
,* {set M1B Control
; set M1T Ctrl
}
1399 unix
,Darwin
{set M1B M1
; set M1T Cmd
}
1400 default
{set M1B M1
; set M1T M1
}
1404 menu .mbar
-tearoff 0
1405 .mbar add cascade
-label Project
-menu .mbar.project
1406 .mbar add cascade
-label Commit
-menu .mbar.commit
1407 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1408 .mbar add cascade
-label Pull
-menu .mbar.pull
1409 .mbar add cascade
-label Push
-menu .mbar.push
1410 . configure
-menu .mbar
1414 .mbar.project add
command -label Visualize \
1417 .mbar.project add
command -label {Repack Database
} \
1418 -command do_repack \
1420 .mbar.project add
command -label Quit \
1422 -accelerator $M1T-Q \
1427 .mbar.commit add
command -label Rescan \
1428 -command do_rescan \
1431 lappend disable_on_lock \
1432 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1433 .mbar.commit add
command -label {Amend Last Commit
} \
1434 -command do_amend_last \
1436 lappend disable_on_lock \
1437 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1438 .mbar.commit add
command -label {Check-in All Files
} \
1439 -command do_checkin_all \
1440 -accelerator $M1T-U \
1442 lappend disable_on_lock \
1443 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1444 .mbar.commit add
command -label {Sign Off
} \
1445 -command do_signoff \
1446 -accelerator $M1T-S \
1448 .mbar.commit add
command -label Commit \
1449 -command do_commit \
1450 -accelerator $M1T-Return \
1452 lappend disable_on_lock \
1453 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1464 # -- Main Window Layout
1465 panedwindow .vpane
-orient vertical
1466 panedwindow .vpane.files
-orient horizontal
1467 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
1468 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1470 # -- Index File List
1471 frame .vpane.files.index
-height 100 -width 400
1472 label .vpane.files.index.title
-text {Modified Files
} \
1475 text
$ui_index -background white
-borderwidth 0 \
1476 -width 40 -height 10 \
1478 -yscrollcommand {.vpane.files.index.sb
set} \
1479 -cursor $maincursor \
1481 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
1482 pack .vpane.files.index.title
-side top
-fill x
1483 pack .vpane.files.index.sb
-side right
-fill y
1484 pack
$ui_index -side left
-fill both
-expand 1
1485 .vpane.files add .vpane.files.index
-sticky nsew
1487 # -- Other (Add) File List
1488 frame .vpane.files.other
-height 100 -width 100
1489 label .vpane.files.other.title
-text {Untracked Files
} \
1492 text
$ui_other -background white
-borderwidth 0 \
1493 -width 40 -height 10 \
1495 -yscrollcommand {.vpane.files.other.sb
set} \
1496 -cursor $maincursor \
1498 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
1499 pack .vpane.files.other.title
-side top
-fill x
1500 pack .vpane.files.other.sb
-side right
-fill y
1501 pack
$ui_other -side left
-fill both
-expand 1
1502 .vpane.files add .vpane.files.other
-sticky nsew
1504 $ui_index tag conf in_diff
-font [concat
$mainfont bold
]
1505 $ui_other tag conf in_diff
-font [concat
$mainfont bold
]
1507 # -- Diff and Commit Area
1508 frame .vpane.lower
-height 400 -width 400
1509 frame .vpane.lower.commarea
1510 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1511 pack .vpane.lower.commarea
-side top
-fill x
1512 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1513 .vpane add .vpane.lower
-stick nsew
1515 # -- Commit Area Buttons
1516 frame .vpane.lower.commarea.buttons
1517 label .vpane.lower.commarea.buttons.l
-text {} \
1521 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1522 pack .vpane.lower.commarea.buttons
-side left
-fill y
1524 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1525 -command do_rescan \
1527 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1528 lappend disable_on_lock
{.vpane.lower.commarea.buttons.rescan conf
-state}
1530 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
1531 -command do_amend_last \
1533 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
1534 lappend disable_on_lock
{.vpane.lower.commarea.buttons.amend conf
-state}
1536 button .vpane.lower.commarea.buttons.ciall
-text {Check-in All
} \
1537 -command do_checkin_all \
1539 pack .vpane.lower.commarea.buttons.ciall
-side top
-fill x
1540 lappend disable_on_lock
{.vpane.lower.commarea.buttons.ciall conf
-state}
1542 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1543 -command do_signoff \
1545 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1547 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1548 -command do_commit \
1550 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1551 lappend disable_on_lock
{.vpane.lower.commarea.buttons.commit conf
-state}
1553 # -- Commit Message Buffer
1554 frame .vpane.lower.commarea.buffer
1555 set ui_comm .vpane.lower.commarea.buffer.t
1556 set ui_coml .vpane.lower.commarea.buffer.l
1557 label
$ui_coml -text {Commit Message
:} \
1561 trace add variable commit_type
write {uplevel
#0 {
1562 switch
-glob $commit_type \
1563 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
1564 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
1565 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
1566 * {$ui_coml conf
-text {Commit Message
:}}
1568 text
$ui_comm -background white
-borderwidth 1 \
1570 -width 75 -height 9 -wrap none \
1572 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set} \
1574 scrollbar .vpane.lower.commarea.buffer.sby
-command [list
$ui_comm yview
]
1575 pack
$ui_coml -side top
-fill x
1576 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1577 pack
$ui_comm -side left
-fill y
1578 pack .vpane.lower.commarea.buffer
-side left
-fill y
1581 set ui_fname_value
{}
1582 set ui_fstatus_value
{}
1583 frame .vpane.lower.
diff.header
-background orange
1584 label .vpane.lower.
diff.header.l1
-text {File
:} \
1585 -background orange \
1587 label .vpane.lower.
diff.header.l2
-textvariable ui_fname_value \
1588 -background orange \
1592 label .vpane.lower.
diff.header.l3
-text {Status
:} \
1593 -background orange \
1595 label .vpane.lower.
diff.header.l4
-textvariable ui_fstatus_value \
1596 -background orange \
1597 -width $max_status_desc \
1601 pack .vpane.lower.
diff.header.l1
-side left
1602 pack .vpane.lower.
diff.header.l2
-side left
-fill x
1603 pack .vpane.lower.
diff.header.l4
-side right
1604 pack .vpane.lower.
diff.header.l3
-side right
1607 frame .vpane.lower.
diff.body
1608 set ui_diff .vpane.lower.
diff.body.t
1609 text
$ui_diff -background white
-borderwidth 0 \
1610 -width 80 -height 15 -wrap none \
1612 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
1613 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
1614 -cursor $maincursor \
1616 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
1617 -command [list
$ui_diff xview
]
1618 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
1619 -command [list
$ui_diff yview
]
1620 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
1621 pack .vpane.lower.
diff.body.sby
-side right
-fill y
1622 pack
$ui_diff -side left
-fill both
-expand 1
1623 pack .vpane.lower.
diff.header
-side top
-fill x
1624 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
1626 $ui_diff tag conf dm
-foreground red
1627 $ui_diff tag conf dp
-foreground blue
1628 $ui_diff tag conf da
-font [concat
$difffont bold
]
1629 $ui_diff tag conf di
-foreground "#00a000"
1630 $ui_diff tag conf dni
-foreground "#a000a0"
1631 $ui_diff tag conf bold
-font [concat
$difffont bold
]
1634 set ui_status_value
{Initializing...
}
1635 label .status
-textvariable ui_status_value \
1641 pack .status
-anchor w
-side bottom
-fill x
1644 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
1645 bind .
<Destroy
> do_quit
1646 bind all
<Key-F5
> do_rescan
1647 bind all
<$M1B-Key-r> do_rescan
1648 bind all
<$M1B-Key-R> do_rescan
1649 bind .
<$M1B-Key-s> do_signoff
1650 bind .
<$M1B-Key-S> do_signoff
1651 bind .
<$M1B-Key-u> do_checkin_all
1652 bind .
<$M1B-Key-U> do_checkin_all
1653 bind .
<$M1B-Key-Return> do_commit
1654 bind all
<$M1B-Key-q> do_quit
1655 bind all
<$M1B-Key-Q> do_quit
1656 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1657 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1658 foreach i
[list
$ui_index $ui_other] {
1659 bind $i <Button-1
> {click
%W
%x
%y
1 %X
%Y
; break}
1660 bind $i <Button-3
> {click
%W
%x
%y
3 %X
%Y
; break}
1661 bind $i <ButtonRelease-1
> {unclick
%W
%x
%y
; break}
1665 ######################################################################
1669 set appname
[lindex
[file split $argv0] end
]
1672 if {[catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]} {
1673 show_msg
{} .
"Cannot find the git directory: $err"
1681 if {[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
1682 show_msg
{} .
"Cannot find the git directory: $err"
1686 if {$appname == {git-citool
}} {
1690 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
1691 focus
-force $ui_comm
1694 populate_remote_menu .mbar.fetch From fetch_from
1695 populate_remote_menu .mbar.push To push_to
1696 populate_pull_menu .mbar.pull