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 ######################################################################
14 proc load_repo_config
{} {
16 global cfg_trust_mtime
18 array
unset repo_config
20 set fd_rc
[open
"| git repo-config --list" r
]
21 while {[gets
$fd_rc line
] >= 0} {
22 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
23 lappend repo_config
($name) $value
29 if {[catch
{set cfg_trust_mtime \
30 [lindex
$repo_config(gui.trustmtime
) 0]
32 set cfg_trust_mtime false
36 proc save_my_config
{} {
38 global cfg_trust_mtime
40 if {[catch
{set rc_trustMTime
$repo_config(gui.trustmtime
)}]} {
41 set rc_trustMTime
[list false
]
43 if {$cfg_trust_mtime != [lindex
$rc_trustMTime 0]} {
44 exec git repo-config gui.trustMTime
$cfg_trust_mtime
45 set repo_config
(gui.trustmtime
) [list
$cfg_trust_mtime]
48 set cfg_geometry
[list \
50 [.vpane sash coord
0] \
51 [.vpane.files sash coord
0] \
53 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
54 set rc_geometry
[list
[list
]]
56 if {$cfg_geometry != [lindex
$rc_geometry 0]} {
57 exec git repo-config gui.geometry
$cfg_geometry
58 set repo_config
(gui.geometry
) [list
$cfg_geometry]
62 ######################################################################
66 set appname
[lindex
[file split $argv0] end
]
68 set GIT_COMMITTER_IDENT
{}
70 if {[catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]} {
71 show_msg
{} .
"Cannot find the git directory: $err"
79 if {[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
80 show_msg
{} .
"Cannot find the git directory: $err"
84 if {$appname == {git-citool
}} {
90 ######################################################################
99 set update_index_fd
{}
101 set disable_on_lock
[list
]
102 set index_lock_type none
108 proc lock_index
{type} {
109 global index_lock_type disable_on_lock
111 if {$index_lock_type == {none
}} {
112 set index_lock_type
$type
113 foreach w
$disable_on_lock {
114 uplevel
#0 $w disabled
117 } elseif
{$index_lock_type == {begin-update
} && $type == {update
}} {
118 set index_lock_type
$type
124 proc unlock_index
{} {
125 global index_lock_type disable_on_lock
127 set index_lock_type none
128 foreach w
$disable_on_lock {
133 ######################################################################
137 proc repository_state
{hdvar ctvar
} {
139 upvar
$hdvar hd
$ctvar ct
141 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
143 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
150 proc update_status
{{final Ready.
}} {
151 global HEAD PARENT commit_type
152 global ui_index ui_other ui_status_value ui_comm
153 global status_active file_states
154 global cfg_trust_mtime
156 if {$status_active ||
![lock_index
read]} return
158 repository_state new_HEAD new_type
159 if {$commit_type == {amend
}
160 && $new_type == {normal
}
161 && $new_HEAD == $HEAD} {
165 set commit_type
$new_type
168 array
unset file_states
169 foreach w
[list
$ui_index $ui_other] {
170 $w conf
-state normal
172 $w conf
-state disabled
175 if {![$ui_comm edit modified
]
176 ||
[string trim
[$ui_comm get
0.0 end
]] == {}} {
177 if {[load_message GITGUI_MSG
]} {
178 } elseif
{[load_message MERGE_MSG
]} {
179 } elseif
{[load_message SQUASH_MSG
]} {
181 $ui_comm edit modified false
184 if {$cfg_trust_mtime == {true
}} {
185 update_status_stage2
{} $final
188 set ui_status_value
{Refreshing
file status...
}
189 set fd_rf
[open
"| git update-index -q --unmerged --refresh" r
]
190 fconfigure
$fd_rf -blocking 0 -translation binary
191 fileevent
$fd_rf readable
[list update_status_stage2
$fd_rf $final]
195 proc update_status_stage2
{fd final
} {
196 global gitdir PARENT commit_type
197 global ui_index ui_other ui_status_value ui_comm
198 global status_active file_states
199 global buf_rdi buf_rdf buf_rlo
203 if {![eof
$fd]} return
207 set ls_others
[list | git ls-files
--others -z \
208 --exclude-per-directory=.gitignore
]
209 set info_exclude
[file join $gitdir info exclude
]
210 if {[file readable
$info_exclude]} {
211 lappend ls_others
"--exclude-from=$info_exclude"
219 set ui_status_value
{Scanning
for modified files ...
}
220 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
221 set fd_df
[open
"| git diff-files -z" r
]
222 set fd_lo
[open
$ls_others r
]
224 fconfigure
$fd_di -blocking 0 -translation binary
225 fconfigure
$fd_df -blocking 0 -translation binary
226 fconfigure
$fd_lo -blocking 0 -translation binary
227 fileevent
$fd_di readable
[list read_diff_index
$fd_di $final]
228 fileevent
$fd_df readable
[list read_diff_files
$fd_df $final]
229 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $final]
232 proc load_message
{file} {
233 global gitdir ui_comm
235 set f
[file join $gitdir $file]
236 if {[file isfile
$f]} {
237 if {[catch
{set fd
[open
$f r
]}]} {
240 set content
[string trim
[read $fd]]
242 $ui_comm delete
0.0 end
243 $ui_comm insert end
$content
249 proc read_diff_index
{fd final
} {
252 append buf_rdi
[read $fd]
254 set n
[string length
$buf_rdi]
256 set z1
[string first
"\0" $buf_rdi $c]
259 set z2
[string first
"\0" $buf_rdi $z1]
265 [string range
$buf_rdi $z1 $z2] \
266 [string index
$buf_rdi [expr $z1 - 2]]_
270 set buf_rdi
[string range
$buf_rdi $c end
]
275 status_eof
$fd buf_rdi
$final
278 proc read_diff_files
{fd final
} {
281 append buf_rdf
[read $fd]
283 set n
[string length
$buf_rdf]
285 set z1
[string first
"\0" $buf_rdf $c]
288 set z2
[string first
"\0" $buf_rdf $z1]
294 [string range
$buf_rdf $z1 $z2] \
295 _
[string index
$buf_rdf [expr $z1 - 2]]
299 set buf_rdf
[string range
$buf_rdf $c end
]
304 status_eof
$fd buf_rdf
$final
307 proc read_ls_others
{fd final
} {
310 append buf_rlo
[read $fd]
311 set pck
[split $buf_rlo "\0"]
312 set buf_rlo
[lindex
$pck end
]
313 foreach p
[lrange
$pck 0 end-1
] {
316 status_eof
$fd buf_rlo
$final
319 proc status_eof
{fd buf final
} {
320 global status_active
$buf
321 global ui_fname_value ui_status_value file_states
327 if {[incr status_active
-1] == 0} {
331 set ui_status_value
$final
333 if {$ui_fname_value != {} && [array names file_states \
334 -exact $ui_fname_value] != {}} {
335 show_diff
$ui_fname_value
343 ######################################################################
348 global ui_diff ui_fname_value ui_fstatus_value
350 $ui_diff conf
-state normal
351 $ui_diff delete
0.0 end
352 $ui_diff conf
-state disabled
353 set ui_fname_value
{}
354 set ui_fstatus_value
{}
357 proc show_diff
{path
} {
358 global file_states PARENT diff_3way diff_active
359 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
361 if {$diff_active ||
![lock_index
read]} return
364 set s
$file_states($path)
368 set ui_fname_value
$path
369 set ui_fstatus_value
[mapdesc
$m $path]
370 set ui_status_value
"Loading diff of $path..."
372 set cmd
[list | git diff-index
-p $PARENT -- $path]
377 set cmd
[list | git diff-index
-p -c $PARENT $path]
381 set fd
[open
$path r
]
382 set content
[read $fd]
387 set ui_status_value
"Unable to display $path"
388 error_popup
"Error loading file:\n$err"
391 $ui_diff conf
-state normal
392 $ui_diff insert end
$content
393 $ui_diff conf
-state disabled
396 set ui_status_value
{Ready.
}
401 if {[catch
{set fd
[open
$cmd r
]} err
]} {
404 set ui_status_value
"Unable to display $path"
405 error_popup
"Error loading diff:\n$err"
409 fconfigure
$fd -blocking 0 -translation auto
410 fileevent
$fd readable
[list read_diff
$fd]
413 proc read_diff
{fd
} {
414 global ui_diff ui_status_value diff_3way diff_active
416 while {[gets
$fd line
] >= 0} {
417 if {[string match
{diff --git *} $line]} continue
418 if {[string match
{diff --combined *} $line]} continue
419 if {[string match
{--- *} $line]} continue
420 if {[string match
{+++ *} $line]} continue
421 if {[string match index
* $line]} {
422 if {[string first
, $line] >= 0} {
427 $ui_diff conf
-state normal
429 set x
[string index
$line 0]
434 default
{set tags
{}}
437 set x
[string range
$line 0 1]
439 default
{set tags
{}}
441 "++" {set tags dp
; set x
" +"}
442 " +" {set tags
{di bold
}; set x
"++"}
443 "+ " {set tags dni
; set x
"-+"}
444 "--" {set tags dm
; set x
" -"}
445 " -" {set tags
{dm bold
}; set x
"--"}
446 "- " {set tags di
; set x
"+-"}
447 default
{set tags
{}}
449 set line
[string replace
$line 0 1 $x]
451 $ui_diff insert end
$line $tags
452 $ui_diff insert end
"\n"
453 $ui_diff conf
-state disabled
460 set ui_status_value
{Ready.
}
464 ######################################################################
468 proc load_last_commit
{} {
469 global HEAD PARENT commit_type ui_comm
471 if {$commit_type == {amend
}} return
472 if {$commit_type != {normal
}} {
473 error_popup
"Can't amend a $commit_type commit."
481 set fd
[open
"| git cat-file commit $HEAD" r
]
482 while {[gets
$fd line
] > 0} {
483 if {[string match
{parent
*} $line]} {
484 set parent
[string range
$line 7 end
]
488 set msg
[string trim
[read $fd]]
491 error_popup
"Error loading commit data for amend:\n$err"
495 if {$parent_count == 0} {
496 set commit_type amend
500 } elseif
{$parent_count == 1} {
501 set commit_type amend
503 $ui_comm delete
0.0 end
504 $ui_comm insert end
$msg
505 $ui_comm edit modified false
508 error_popup
{You can
't amend a merge commit.}
513 proc commit_tree {} {
514 global tcl_platform HEAD gitdir commit_type file_states
515 global commit_active ui_status_value
518 if {$commit_active || ![lock_index update]} return
520 # -- Our in memory state should match the repository.
522 repository_state curHEAD cur_type
523 if {$commit_type == {amend}
524 && $cur_type == {normal}
525 && $curHEAD == $HEAD} {
526 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
527 error_popup {Last scanned state does not match repository state.
529 Its highly likely that another Git program modified the
530 repository since our last scan. A rescan is required
538 # -- At least one file should differ in the index.
541 foreach path [array names file_states] {
542 set s $file_states($path)
543 switch -glob -- [lindex $s 0] {
547 M* {set files_ready 1; break}
549 error_popup "Unmerged files cannot be committed.
551 File $path has merge conflicts.
552 You must resolve them and include the file before committing.
558 error_popup "Unknown file state [lindex $s 0] detected.
560 File $path cannot be committed by this program.
566 error_popup {No included files to commit.
568 You must include at least 1 file before you can commit.
574 # -- A message is required.
576 set msg [string trim [$ui_comm get 1.0 end]]
578 error_popup {Please supply a commit message.
580 A good commit message has the following format:
582 - First line: Describe in one sentance what you did.
584 - Remaining lines: Describe why this change is good.
590 # -- Ask the pre-commit hook for the go-ahead.
592 set pchook [file join $gitdir hooks pre-commit]
593 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
594 set pchook [list sh -c \
595 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
596 } elseif {[file executable $pchook]} {
597 set pchook [list $pchook]
601 if {$pchook != {} && [catch {eval exec $pchook} err]} {
602 hook_failed_popup pre-commit $err
607 # -- Write the tree in the background.
610 set ui_status_value {Committing changes...}
612 set fd_wt [open "| git write-tree" r]
613 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
616 proc commit_stage2 {fd_wt curHEAD msg} {
617 global single_commit gitdir PARENT commit_type
618 global commit_active ui_status_value ui_comm
623 if {$tree_id == {}} {
624 error_popup "write-tree failed"
626 set ui_status_value {Commit failed.}
631 # -- Create the commit.
633 set cmd [list git commit-tree $tree_id]
635 lappend cmd -p $PARENT
637 if {$commit_type == {merge}} {
639 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
640 while {[gets $fd_mh merge_head] >= 0} {
641 lappend cmd -p $merge_head
645 error_popup "Loading MERGE_HEADs failed:\n$err"
647 set ui_status_value {Commit failed.}
653 # git commit-tree writes to stderr during initial commit.
654 lappend cmd 2>/dev/null
657 if {[catch {set cmt_id [eval exec $cmd]} err]} {
658 error_popup "commit-tree failed:\n$err"
660 set ui_status_value {Commit failed.}
665 # -- Update the HEAD ref.
668 if {$commit_type != {normal}} {
669 append reflogm " ($commit_type)"
671 set i [string first "\n" $msg]
673 append reflogm {: } [string range $msg 0 [expr $i - 1]]
675 append reflogm {: } $msg
677 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
678 if {[catch {eval exec $cmd} err]} {
679 error_popup "update-ref failed:\n$err"
681 set ui_status_value {Commit failed.}
686 # -- Cleanup after ourselves.
688 catch {file delete [file join $gitdir MERGE_HEAD]}
689 catch {file delete [file join $gitdir MERGE_MSG]}
690 catch {file delete [file join $gitdir SQUASH_MSG]}
691 catch {file delete [file join $gitdir GITGUI_MSG]}
693 # -- Let rerere do its thing.
695 if {[file isdirectory [file join $gitdir rr-cache]]} {
696 catch {exec git rerere}
699 $ui_comm delete 0.0 end
700 $ui_comm edit modified false
702 if {$single_commit} do_quit
709 update_status "Changes committed as [string range $cmt_id 0 7]."
712 ######################################################################
716 proc fetch_from {remote} {
717 set w [new_console "fetch $remote" \
718 "Fetching new changes from $remote"]
719 set cmd [list git fetch]
724 proc pull_remote {remote branch} {
725 global HEAD commit_type
728 if {![lock_index update]} return
730 # -- Our in memory state should match the repository.
732 repository_state curHEAD cur_type
733 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
734 error_popup {Last scanned state does not match repository state.
736 Its highly likely that another Git program modified the
737 repository since our last scan. A rescan is required
738 before a pull can be started.
745 # -- No differences should exist before a pull.
747 if {[array size file_states] != 0} {
748 error_popup {Uncommitted but modified files are present.
750 You should not perform a pull with unmodified files in your working
751 directory as Git would be unable to recover from an incorrect merge.
753 Commit or throw away all changes before starting a pull operation.
759 set w [new_console "pull $remote $branch" \
760 "Pulling new changes from branch $branch in $remote"]
761 set cmd [list git pull]
764 console_exec $w $cmd [list post_pull_remote $remote $branch]
767 proc post_pull_remote {remote branch success} {
768 global HEAD PARENT commit_type
769 global ui_status_value
773 repository_state HEAD commit_type
775 set $ui_status_value {Ready.}
777 update_status "Conflicts detected while pulling $branch from $remote."
781 proc push_to {remote} {
782 set w [new_console "push $remote" \
783 "Pushing changes to $remote"]
784 set cmd [list git push]
789 ######################################################################
793 proc mapcol {state path} {
794 global all_cols ui_other
796 if {[catch {set r $all_cols($state)}]} {
797 puts "error: no column for state={$state} $path"
803 proc mapicon {state path} {
806 if {[catch {set r $all_icons($state)}]} {
807 puts "error: no icon for state={$state} $path"
813 proc mapdesc {state path} {
816 if {[catch {set r $all_descs($state)}]} {
817 puts "error: no desc for state={$state} $path"
823 proc bsearch {w path} {
824 set hi [expr [lindex [split [$w index end] .] 0] - 2]
830 set mi [expr [expr $lo + $hi] / 2]
831 set ti [expr $mi + 1]
832 set cmp [string compare [$w get $ti.1 $ti.end] $path]
835 } elseif {$cmp == 0} {
841 return -[expr $lo + 1]
846 proc merge_state {path new_state} {
847 global file_states next_icon_id
849 set s0 [string index $new_state 0]
850 set s1 [string index $new_state 1]
852 if {[catch {set info $file_states($path)}]} {
854 set icon n[incr next_icon_id]
856 set state [lindex $info 0]
857 set icon [lindex $info 1]
861 set s0 [string index $state 0]
862 } elseif {$s0 == {*}} {
867 set s1 [string index $state 1]
868 } elseif {$s1 == {*}} {
872 set file_states($path) [list $s0$s1 $icon]
876 proc display_file {path state} {
877 global ui_index ui_other file_states status_active
879 set old_m [merge_state $path $state]
880 if {$status_active} return
882 set s $file_states($path)
883 set new_m [lindex $s 0]
884 set new_w [mapcol $new_m $path]
885 set old_w [mapcol $old_m $path]
886 set new_icon [mapicon $new_m $path]
888 if {$new_w != $old_w} {
889 set lno [bsearch $old_w $path]
892 $old_w conf -state normal
893 $old_w delete $lno.0 [expr $lno + 1].0
894 $old_w conf -state disabled
897 set lno [expr abs([bsearch $new_w $path] + 1) + 1]
898 $new_w conf -state normal
899 $new_w image create $lno.0 \
900 -align center -padx 5 -pady 1 \
901 -name [lindex $s 1] \
903 $new_w insert $lno.1 "$path\n"
904 $new_w conf -state disabled
905 } elseif {$new_icon != [mapicon $old_m $path]} {
906 $new_w conf -state normal
907 $new_w image conf [lindex $s 1] -image $new_icon
908 $new_w conf -state disabled
912 proc display_all_files {} {
913 global ui_index ui_other file_states
915 $ui_index conf -state normal
916 $ui_other conf -state normal
918 foreach path [lsort [array names file_states]] {
919 set s $file_states($path)
921 set w [mapcol $m $path]
922 $w image create end \
923 -align center -padx 5 -pady 1 \
924 -name [lindex $s 1] \
925 -image [mapicon $m $path]
926 $w insert end "$path\n"
929 $ui_index conf -state disabled
930 $ui_other conf -state disabled
933 proc with_update_index {body} {
934 global update_index_fd
936 if {$update_index_fd == {}} {
937 if {![lock_index update]} return
938 set update_index_fd [open \
939 "| git update-index --add --remove -z --stdin" \
941 fconfigure $update_index_fd -translation binary
943 close $update_index_fd
944 set update_index_fd {}
951 proc update_index {path} {
952 global update_index_fd
954 if {$update_index_fd == {}} {
955 error {not in with_update_index}
957 puts -nonewline $update_index_fd "$path\0"
961 proc toggle_mode {path} {
962 global file_states ui_fname_value
964 set s $file_states($path)
977 with_update_index {update_index $path}
978 display_file $path $new
979 if {$ui_fname_value == $path} {
984 ######################################################################
988 proc load_all_remotes {} {
989 global gitdir all_remotes repo_config
991 set all_remotes [list]
992 set rm_dir [file join $gitdir remotes]
993 if {[file isdirectory $rm_dir]} {
994 set all_remotes [concat $all_remotes [glob \
998 -directory $rm_dir *]]
1001 foreach line [array names repo_config remote.*.url] {
1002 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1003 lappend all_remotes $name
1007 set all_remotes [lsort -unique $all_remotes]
1010 proc populate_remote_menu {m pfx op} {
1011 global all_remotes mainfont
1013 foreach remote $all_remotes {
1014 $m add command -label "$pfx $remote..." \
1015 -command [list $op $remote] \
1020 proc populate_pull_menu {m} {
1021 global gitdir repo_config all_remotes mainfont disable_on_lock
1023 foreach remote $all_remotes {
1025 if {[array get repo_config remote.$remote.url] != {}} {
1026 if {[array get repo_config remote.$remote.fetch] != {}} {
1027 regexp {^([^:]+):} \
1028 [lindex $repo_config(remote.$remote.fetch) 0] \
1033 set fd [open [file join $gitdir remotes $remote] r]
1034 while {[gets $fd line] >= 0} {
1035 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1044 regsub ^refs/heads/ $rb {} rb_short
1045 if {$rb_short != {}} {
1047 -label "Branch $rb_short from $remote..." \
1048 -command [list pull_remote $remote $rb] \
1050 lappend disable_on_lock \
1051 [list $m entryconf [$m index last] -state]
1056 ######################################################################
1061 #define mask_width 14
1062 #define mask_height 15
1063 static unsigned char mask_bits[] = {
1064 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1065 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1066 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1069 image create bitmap file_plain -background white -foreground black -data {
1070 #define plain_width 14
1071 #define plain_height 15
1072 static unsigned char plain_bits[] = {
1073 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1074 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1075 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1076 } -maskdata $filemask
1078 image create bitmap file_mod -background white -foreground blue -data {
1079 #define mod_width 14
1080 #define mod_height 15
1081 static unsigned char mod_bits[] = {
1082 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1083 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1084 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1085 } -maskdata $filemask
1087 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1088 #define file_fulltick_width 14
1089 #define file_fulltick_height 15
1090 static unsigned char file_fulltick_bits[] = {
1091 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1092 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1093 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1094 } -maskdata $filemask
1096 image create bitmap file_parttick -background white -foreground "#005050" -data {
1097 #define parttick_width 14
1098 #define parttick_height 15
1099 static unsigned char parttick_bits[] = {
1100 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1101 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1102 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1103 } -maskdata $filemask
1105 image create bitmap file_question -background white -foreground black -data {
1106 #define file_question_width 14
1107 #define file_question_height 15
1108 static unsigned char file_question_bits[] = {
1109 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1110 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1111 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1112 } -maskdata $filemask
1114 image create bitmap file_removed -background white -foreground red -data {
1115 #define file_removed_width 14
1116 #define file_removed_height 15
1117 static unsigned char file_removed_bits[] = {
1118 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1119 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1120 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1121 } -maskdata $filemask
1123 image create bitmap file_merge -background white -foreground blue -data {
1124 #define file_merge_width 14
1125 #define file_merge_height 15
1126 static unsigned char file_merge_bits[] = {
1127 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1128 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1129 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1130 } -maskdata $filemask
1132 set ui_index .vpane.files.index.list
1133 set ui_other .vpane.files.other.list
1134 set max_status_desc 0
1136 {__ i plain "Unmodified"}
1137 {_M i mod "Modified"}
1138 {M_ i fulltick "Checked in"}
1139 {MM i parttick "Partially included"}
1141 {_O o plain "Untracked"}
1142 {A_ o fulltick "Added"}
1143 {AM o parttick "Partially added"}
1144 {AD o question "Added (but now gone)"}
1146 {_D i question "Missing"}
1147 {D_ i removed "Removed"}
1148 {DD i removed "Removed"}
1149 {DO i removed "Removed (still exists)"}
1151 {UM i merge "Merge conflicts"}
1152 {U_ i merge "Merge conflicts"}
1154 if {$max_status_desc < [string length [lindex $i 3]]} {
1155 set max_status_desc [string length [lindex $i 3]]
1157 if {[lindex $i 1] == {i}} {
1158 set all_cols([lindex $i 0]) $ui_index
1160 set all_cols([lindex $i 0]) $ui_other
1162 set all_icons([lindex $i 0]) file_[lindex $i 2]
1163 set all_descs([lindex $i 0]) [lindex $i 3]
1167 ######################################################################
1171 proc error_popup {msg} {
1178 proc show_msg {w top msg} {
1179 global gitdir appname mainfont
1181 message $w.m -text $msg -justify left -aspect 400
1182 pack $w.m -side top -fill x -padx 5 -pady 10
1183 button $w.ok -text OK \
1186 -command "destroy $top"
1187 pack $w.ok -side bottom
1188 bind $top <Visibility> "grab $top; focus $top"
1189 bind $top <Key-Return> "destroy $top"
1190 wm title $w "$appname ([lindex [file split \
1191 [file normalize [file dirname $gitdir]]] \
1196 proc hook_failed_popup {hook msg} {
1197 global gitdir mainfont difffont appname
1204 label $w.m.l1 -text "$hook hook failed:" \
1207 -font [concat $mainfont bold]
1209 -background white -borderwidth 1 \
1211 -width 80 -height 10 \
1213 -yscrollcommand [list $w.m.sby set]
1215 -text {You must correct the above errors before committing.} \
1218 -font [concat $mainfont bold]
1219 scrollbar $w.m.sby -command [list $w.m.t yview]
1220 pack $w.m.l1 -side top -fill x
1221 pack $w.m.l2 -side bottom -fill x
1222 pack $w.m.sby -side right -fill y
1223 pack $w.m.t -side left -fill both -expand 1
1224 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1226 $w.m.t insert 1.0 $msg
1227 $w.m.t conf -state disabled
1229 button $w.ok -text OK \
1232 -command "destroy $w"
1233 pack $w.ok -side bottom
1235 bind $w <Visibility> "grab $w; focus $w"
1236 bind $w <Key-Return> "destroy $w"
1237 wm title $w "$appname ([lindex [file split \
1238 [file normalize [file dirname $gitdir]]] \
1243 set next_console_id 0
1245 proc new_console {short_title long_title} {
1246 global next_console_id console_data
1247 set w .console[incr next_console_id]
1248 set console_data($w) [list $short_title $long_title]
1249 return [console_init $w]
1252 proc console_init {w} {
1253 global console_cr console_data
1254 global gitdir appname mainfont difffont
1256 set console_cr($w) 1.0
1259 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1262 -font [concat $mainfont bold]
1264 -background white -borderwidth 1 \
1266 -width 80 -height 10 \
1269 -yscrollcommand [list $w.m.sby set]
1270 label $w.m.s -anchor w \
1272 -font [concat $mainfont bold]
1273 scrollbar $w.m.sby -command [list $w.m.t yview]
1274 pack $w.m.l1 -side top -fill x
1275 pack $w.m.s -side bottom -fill x
1276 pack $w.m.sby -side right -fill y
1277 pack $w.m.t -side left -fill both -expand 1
1278 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1280 button $w.ok -text {Running...} \
1284 -command "destroy $w"
1285 pack $w.ok -side bottom
1287 bind $w <Visibility> "focus $w"
1288 wm title $w "$appname ([lindex [file split \
1289 [file normalize [file dirname $gitdir]]] \
1290 end]): [lindex $console_data($w) 0]"
1294 proc console_exec {w cmd {after {}}} {
1297 # -- Windows tosses the enviroment when we exec our child.
1298 # But most users need that so we have to relogin. :-(
1300 if {$tcl_platform(platform) == {windows}} {
1301 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1304 # -- Tcl won't
let us redirect both stdout and stderr to
1305 # the same pipe. So pass it through cat...
1307 set cmd
[concat |
$cmd |
& cat]
1309 set fd_f
[open
$cmd r
]
1310 fconfigure
$fd_f -blocking 0 -translation binary
1311 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1314 proc console_read
{w fd after
} {
1315 global console_cr console_data
1319 if {![winfo exists
$w]} {console_init
$w}
1320 $w.m.t conf
-state normal
1322 set n
[string length
$buf]
1324 set cr
[string first
"\r" $buf $c]
1325 set lf
[string first
"\n" $buf $c]
1326 if {$cr < 0} {set cr
[expr $n + 1]}
1327 if {$lf < 0} {set lf
[expr $n + 1]}
1330 $w.m.t insert end
[string range
$buf $c $lf]
1331 set console_cr
($w) [$w.m.t index
{end
-1c}]
1335 $w.m.t delete
$console_cr($w) end
1336 $w.m.t insert end
"\n"
1337 $w.m.t insert end
[string range
$buf $c $cr]
1342 $w.m.t conf
-state disabled
1346 fconfigure
$fd -blocking 1
1348 if {[catch
{close
$fd}]} {
1349 if {![winfo exists
$w]} {console_init
$w}
1350 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1351 $w.ok conf
-text Close
1352 $w.ok conf
-state normal
1354 } elseif
{[winfo exists
$w]} {
1355 $w.m.s conf
-background green
-text {Success
}
1356 $w.ok conf
-text Close
1357 $w.ok conf
-state normal
1360 array
unset console_cr
$w
1361 array
unset console_data
$w
1363 uplevel
#0 $after $ok
1367 fconfigure
$fd -blocking 0
1370 ######################################################################
1374 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1377 global tcl_platform ui_status_value starting_gitk_msg
1379 set ui_status_value
$starting_gitk_msg
1381 if {$ui_status_value == $starting_gitk_msg} {
1382 set ui_status_value
{Ready.
}
1386 if {$tcl_platform(platform
) == {windows
}} {
1394 set w
[new_console
"repack" "Repacking the object database"]
1395 set cmd
[list git repack
]
1398 console_exec
$w $cmd
1402 global gitdir ui_comm
1404 set save
[file join $gitdir GITGUI_MSG
]
1405 set msg
[string trim
[$ui_comm get
0.0 end
]]
1406 if {[$ui_comm edit modified
] && $msg != {}} {
1408 set fd
[open
$save w
]
1409 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1412 } elseif
{$msg == {} && [file exists
$save]} {
1424 proc do_include_all
{} {
1425 global update_active ui_status_value
1427 if {$update_active ||
![lock_index begin-update
]} return
1430 set ui_status_value
{Including all modified files...
}
1433 foreach path
[array names file_states
] {
1434 set s
$file_states($path)
1440 _D
{toggle_mode
$path}
1445 set ui_status_value
{Ready.
}
1449 proc do_signoff
{} {
1450 global ui_comm GIT_COMMITTER_IDENT
1452 if {$GIT_COMMITTER_IDENT == {}} {
1453 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1454 error_popup
"Unable to obtain your identity:\n$err"
1457 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1458 $me me GIT_COMMITTER_IDENT
]} {
1459 error_popup
"Invalid GIT_COMMITTER_IDENT:\n$me"
1464 set str
"Signed-off-by: $GIT_COMMITTER_IDENT"
1465 if {[$ui_comm get
{end
-1c linestart
} {end
-1c}] != $str} {
1466 $ui_comm insert end
"\n"
1467 $ui_comm insert end
$str
1472 proc do_amend_last
{} {
1480 # shift == 1: left click
1482 proc click
{w x y
shift wx wy
} {
1483 global ui_index ui_other
1485 set pos
[split [$w index @
$x,$y] .
]
1486 set lno
[lindex
$pos 0]
1487 set col [lindex
$pos 1]
1488 set path
[$w get
$lno.1 $lno.end
]
1489 if {$path == {}} return
1491 if {$col > 0 && $shift == 1} {
1492 $ui_index tag remove in_diff
0.0 end
1493 $ui_other tag remove in_diff
0.0 end
1494 $w tag add in_diff
$lno.0 [expr $lno + 1].0
1499 proc unclick
{w x y
} {
1500 set pos
[split [$w index @
$x,$y] .
]
1501 set lno
[lindex
$pos 0]
1502 set col [lindex
$pos 1]
1503 set path
[$w get
$lno.1 $lno.end
]
1504 if {$path == {}} return
1511 ######################################################################
1515 set mainfont
{Helvetica
10}
1516 set difffont
{Courier
10}
1517 set maincursor
[. cget
-cursor]
1519 switch
-glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1520 windows
,* {set M1B Control
; set M1T Ctrl
}
1521 unix
,Darwin
{set M1B M1
; set M1T Cmd
}
1522 default
{set M1B M1
; set M1T M1
}
1526 menu .mbar
-tearoff 0
1527 .mbar add cascade
-label Project
-menu .mbar.project
1528 .mbar add cascade
-label Commit
-menu .mbar.commit
1529 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1530 .mbar add cascade
-label Pull
-menu .mbar.pull
1531 .mbar add cascade
-label Push
-menu .mbar.push
1532 .mbar add cascade
-label Options
-menu .mbar.options
1533 . configure
-menu .mbar
1537 .mbar.project add
command -label Visualize \
1540 .mbar.project add
command -label {Repack Database
} \
1541 -command do_repack \
1543 .mbar.project add
command -label Quit \
1545 -accelerator $M1T-Q \
1550 .mbar.commit add
command -label Rescan \
1551 -command do_rescan \
1554 lappend disable_on_lock \
1555 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1556 .mbar.commit add
command -label {Amend Last Commit
} \
1557 -command do_amend_last \
1559 lappend disable_on_lock \
1560 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1561 .mbar.commit add
command -label {Include All Files
} \
1562 -command do_include_all \
1563 -accelerator $M1T-U \
1565 lappend disable_on_lock \
1566 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1567 .mbar.commit add
command -label {Sign Off
} \
1568 -command do_signoff \
1569 -accelerator $M1T-S \
1571 .mbar.commit add
command -label Commit \
1572 -command do_commit \
1573 -accelerator $M1T-Return \
1575 lappend disable_on_lock \
1576 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1589 .mbar.options add checkbutton
-label {Trust File Modification Timestamps
} \
1592 -variable cfg_trust_mtime
1594 # -- Main Window Layout
1595 panedwindow .vpane
-orient vertical
1596 panedwindow .vpane.files
-orient horizontal
1597 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
1598 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1600 # -- Index File List
1601 frame .vpane.files.index
-height 100 -width 400
1602 label .vpane.files.index.title
-text {Modified Files
} \
1605 text
$ui_index -background white
-borderwidth 0 \
1606 -width 40 -height 10 \
1608 -yscrollcommand {.vpane.files.index.sb
set} \
1609 -cursor $maincursor \
1611 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
1612 pack .vpane.files.index.title
-side top
-fill x
1613 pack .vpane.files.index.sb
-side right
-fill y
1614 pack
$ui_index -side left
-fill both
-expand 1
1615 .vpane.files add .vpane.files.index
-sticky nsew
1617 # -- Other (Add) File List
1618 frame .vpane.files.other
-height 100 -width 100
1619 label .vpane.files.other.title
-text {Untracked Files
} \
1622 text
$ui_other -background white
-borderwidth 0 \
1623 -width 40 -height 10 \
1625 -yscrollcommand {.vpane.files.other.sb
set} \
1626 -cursor $maincursor \
1628 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
1629 pack .vpane.files.other.title
-side top
-fill x
1630 pack .vpane.files.other.sb
-side right
-fill y
1631 pack
$ui_other -side left
-fill both
-expand 1
1632 .vpane.files add .vpane.files.other
-sticky nsew
1634 $ui_index tag conf in_diff
-font [concat
$mainfont bold
]
1635 $ui_other tag conf in_diff
-font [concat
$mainfont bold
]
1637 # -- Diff and Commit Area
1638 frame .vpane.lower
-height 400 -width 400
1639 frame .vpane.lower.commarea
1640 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1641 pack .vpane.lower.commarea
-side top
-fill x
1642 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1643 .vpane add .vpane.lower
-stick nsew
1645 # -- Commit Area Buttons
1646 frame .vpane.lower.commarea.buttons
1647 label .vpane.lower.commarea.buttons.l
-text {} \
1651 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1652 pack .vpane.lower.commarea.buttons
-side left
-fill y
1654 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1655 -command do_rescan \
1657 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1658 lappend disable_on_lock
{.vpane.lower.commarea.buttons.rescan conf
-state}
1660 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
1661 -command do_amend_last \
1663 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
1664 lappend disable_on_lock
{.vpane.lower.commarea.buttons.amend conf
-state}
1666 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
1667 -command do_include_all \
1669 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
1670 lappend disable_on_lock
{.vpane.lower.commarea.buttons.incall conf
-state}
1672 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1673 -command do_signoff \
1675 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1677 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1678 -command do_commit \
1680 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1681 lappend disable_on_lock
{.vpane.lower.commarea.buttons.commit conf
-state}
1683 # -- Commit Message Buffer
1684 frame .vpane.lower.commarea.buffer
1685 set ui_comm .vpane.lower.commarea.buffer.t
1686 set ui_coml .vpane.lower.commarea.buffer.l
1687 label
$ui_coml -text {Commit Message
:} \
1691 trace add variable commit_type
write {uplevel
#0 {
1692 switch
-glob $commit_type \
1693 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
1694 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
1695 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
1696 * {$ui_coml conf
-text {Commit Message
:}}
1698 text
$ui_comm -background white
-borderwidth 1 \
1700 -width 75 -height 9 -wrap none \
1702 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set} \
1704 scrollbar .vpane.lower.commarea.buffer.sby
-command [list
$ui_comm yview
]
1705 pack
$ui_coml -side top
-fill x
1706 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1707 pack
$ui_comm -side left
-fill y
1708 pack .vpane.lower.commarea.buffer
-side left
-fill y
1711 set ui_fname_value
{}
1712 set ui_fstatus_value
{}
1713 frame .vpane.lower.
diff.header
-background orange
1714 label .vpane.lower.
diff.header.l1
-text {File
:} \
1715 -background orange \
1717 label .vpane.lower.
diff.header.l2
-textvariable ui_fname_value \
1718 -background orange \
1722 label .vpane.lower.
diff.header.l3
-text {Status
:} \
1723 -background orange \
1725 label .vpane.lower.
diff.header.l4
-textvariable ui_fstatus_value \
1726 -background orange \
1727 -width $max_status_desc \
1731 pack .vpane.lower.
diff.header.l1
-side left
1732 pack .vpane.lower.
diff.header.l2
-side left
-fill x
1733 pack .vpane.lower.
diff.header.l4
-side right
1734 pack .vpane.lower.
diff.header.l3
-side right
1737 frame .vpane.lower.
diff.body
1738 set ui_diff .vpane.lower.
diff.body.t
1739 text
$ui_diff -background white
-borderwidth 0 \
1740 -width 80 -height 15 -wrap none \
1742 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
1743 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
1744 -cursor $maincursor \
1746 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
1747 -command [list
$ui_diff xview
]
1748 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
1749 -command [list
$ui_diff yview
]
1750 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
1751 pack .vpane.lower.
diff.body.sby
-side right
-fill y
1752 pack
$ui_diff -side left
-fill both
-expand 1
1753 pack .vpane.lower.
diff.header
-side top
-fill x
1754 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
1756 $ui_diff tag conf dm
-foreground red
1757 $ui_diff tag conf dp
-foreground blue
1758 $ui_diff tag conf da
-font [concat
$difffont bold
]
1759 $ui_diff tag conf di
-foreground "#00a000"
1760 $ui_diff tag conf dni
-foreground "#a000a0"
1761 $ui_diff tag conf bold
-font [concat
$difffont bold
]
1764 set ui_status_value
{Initializing...
}
1765 label .status
-textvariable ui_status_value \
1771 pack .status
-anchor w
-side bottom
-fill x
1775 wm geometry .
[lindex
$repo_config(gui.geometry
) 0 0]
1776 eval .vpane sash place
0 [lindex
$repo_config(gui.geometry
) 0 1]
1777 eval .vpane.files sash place
0 [lindex
$repo_config(gui.geometry
) 0 2]
1781 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
1782 bind .
<Destroy
> do_quit
1783 bind all
<Key-F5
> do_rescan
1784 bind all
<$M1B-Key-r> do_rescan
1785 bind all
<$M1B-Key-R> do_rescan
1786 bind .
<$M1B-Key-s> do_signoff
1787 bind .
<$M1B-Key-S> do_signoff
1788 bind .
<$M1B-Key-u> do_include_all
1789 bind .
<$M1B-Key-U> do_include_all
1790 bind .
<$M1B-Key-Return> do_commit
1791 bind all
<$M1B-Key-q> do_quit
1792 bind all
<$M1B-Key-Q> do_quit
1793 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1794 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1795 foreach i
[list
$ui_index $ui_other] {
1796 bind $i <Button-1
> {click
%W
%x
%y
1 %X
%Y
; break}
1797 bind $i <Button-3
> {click
%W
%x
%y
3 %X
%Y
; break}
1798 bind $i <ButtonRelease-1
> {unclick
%W
%x
%y
; break}
1802 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
1803 focus
-force $ui_comm
1805 populate_remote_menu .mbar.fetch From fetch_from
1806 populate_remote_menu .mbar.push To push_to
1807 populate_pull_menu .mbar.pull