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 file_lists
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 array
unset file_lists
170 foreach w
[list
$ui_index $ui_other] {
171 $w conf
-state normal
173 $w conf
-state disabled
176 if {![$ui_comm edit modified
]
177 ||
[string trim
[$ui_comm get
0.0 end
]] == {}} {
178 if {[load_message GITGUI_MSG
]} {
179 } elseif
{[load_message MERGE_MSG
]} {
180 } elseif
{[load_message SQUASH_MSG
]} {
182 $ui_comm edit modified false
186 if {$cfg_trust_mtime == {true
}} {
187 update_status_stage2
{} $final
190 set ui_status_value
{Refreshing
file status...
}
191 set fd_rf
[open
"| git update-index -q --unmerged --refresh" r
]
192 fconfigure
$fd_rf -blocking 0 -translation binary
193 fileevent
$fd_rf readable
[list update_status_stage2
$fd_rf $final]
197 proc update_status_stage2
{fd final
} {
198 global gitdir PARENT commit_type
199 global ui_index ui_other ui_status_value ui_comm
201 global buf_rdi buf_rdf buf_rlo
205 if {![eof
$fd]} return
209 set ls_others
[list | git ls-files
--others -z \
210 --exclude-per-directory=.gitignore
]
211 set info_exclude
[file join $gitdir info exclude
]
212 if {[file readable
$info_exclude]} {
213 lappend ls_others
"--exclude-from=$info_exclude"
221 set ui_status_value
{Scanning
for modified files ...
}
222 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
223 set fd_df
[open
"| git diff-files -z" r
]
224 set fd_lo
[open
$ls_others r
]
226 fconfigure
$fd_di -blocking 0 -translation binary
227 fconfigure
$fd_df -blocking 0 -translation binary
228 fconfigure
$fd_lo -blocking 0 -translation binary
229 fileevent
$fd_di readable
[list read_diff_index
$fd_di $final]
230 fileevent
$fd_df readable
[list read_diff_files
$fd_df $final]
231 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $final]
234 proc load_message
{file} {
235 global gitdir ui_comm
237 set f
[file join $gitdir $file]
238 if {[file isfile
$f]} {
239 if {[catch
{set fd
[open
$f r
]}]} {
242 set content
[string trim
[read $fd]]
244 $ui_comm delete
0.0 end
245 $ui_comm insert end
$content
251 proc read_diff_index
{fd final
} {
254 append buf_rdi
[read $fd]
256 set n
[string length
$buf_rdi]
258 set z1
[string first
"\0" $buf_rdi $c]
261 set z2
[string first
"\0" $buf_rdi $z1]
267 [string range
$buf_rdi $z1 $z2] \
268 [string index
$buf_rdi [expr $z1 - 2]]_
272 set buf_rdi
[string range
$buf_rdi $c end
]
277 status_eof
$fd buf_rdi
$final
280 proc read_diff_files
{fd final
} {
283 append buf_rdf
[read $fd]
285 set n
[string length
$buf_rdf]
287 set z1
[string first
"\0" $buf_rdf $c]
290 set z2
[string first
"\0" $buf_rdf $z1]
296 [string range
$buf_rdf $z1 $z2] \
297 _
[string index
$buf_rdf [expr $z1 - 2]]
301 set buf_rdf
[string range
$buf_rdf $c end
]
306 status_eof
$fd buf_rdf
$final
309 proc read_ls_others
{fd final
} {
312 append buf_rlo
[read $fd]
313 set pck
[split $buf_rlo "\0"]
314 set buf_rlo
[lindex
$pck end
]
315 foreach p
[lrange
$pck 0 end-1
] {
318 status_eof
$fd buf_rlo
$final
321 proc status_eof
{fd buf final
} {
322 global status_active
$buf
323 global ui_fname_value ui_status_value file_states
329 if {[incr status_active
-1] == 0} {
333 set ui_status_value
$final
335 if {$ui_fname_value != {} && [array names file_states \
336 -exact $ui_fname_value] != {}} {
337 show_diff
$ui_fname_value
345 ######################################################################
350 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
352 $ui_diff conf
-state normal
353 $ui_diff delete
0.0 end
354 $ui_diff conf
-state disabled
356 set ui_fname_value
{}
357 set ui_fstatus_value
{}
359 $ui_index tag remove in_diff
0.0 end
360 $ui_other tag remove in_diff
0.0 end
363 proc show_diff
{path
{w
{}} {lno
{}}} {
364 global file_states file_lists
365 global PARENT diff_3way diff_active
366 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
368 if {$diff_active ||
![lock_index
read]} return
371 if {$w == {} ||
$lno == {}} {
372 foreach w
[array names file_lists
] {
373 set lno
[lsearch
-sorted $file_lists($w) $path]
380 if {$w != {} && $lno >= 1} {
381 $w tag add in_diff
$lno.0 [expr $lno + 1].0
384 set s
$file_states($path)
388 set ui_fname_value
[escape_path
$path]
389 set ui_fstatus_value
[mapdesc
$m $path]
390 set ui_status_value
"Loading diff of [escape_path $path]..."
392 set cmd
[list | git diff-index
-p $PARENT -- $path]
397 set cmd
[list | git diff-index
-p -c $PARENT $path]
401 set fd
[open
$path r
]
402 set content
[read $fd]
407 set ui_status_value
"Unable to display [escape_path $path]"
408 error_popup
"Error loading file:\n$err"
411 $ui_diff conf
-state normal
412 $ui_diff insert end
$content
413 $ui_diff conf
-state disabled
416 set ui_status_value
{Ready.
}
421 if {[catch
{set fd
[open
$cmd r
]} err
]} {
424 set ui_status_value
"Unable to display [escape_path $path]"
425 error_popup
"Error loading diff:\n$err"
429 fconfigure
$fd -blocking 0 -translation auto
430 fileevent
$fd readable
[list read_diff
$fd]
433 proc read_diff
{fd
} {
434 global ui_diff ui_status_value diff_3way diff_active
436 while {[gets
$fd line
] >= 0} {
437 if {[string match
{diff --git *} $line]} continue
438 if {[string match
{diff --combined *} $line]} continue
439 if {[string match
{--- *} $line]} continue
440 if {[string match
{+++ *} $line]} continue
441 if {[string match index
* $line]} {
442 if {[string first
, $line] >= 0} {
447 $ui_diff conf
-state normal
449 set x
[string index
$line 0]
454 default
{set tags
{}}
457 set x
[string range
$line 0 1]
459 default
{set tags
{}}
461 "++" {set tags dp
; set x
" +"}
462 " +" {set tags
{di bold
}; set x
"++"}
463 "+ " {set tags dni
; set x
"-+"}
464 "--" {set tags dm
; set x
" -"}
465 " -" {set tags
{dm bold
}; set x
"--"}
466 "- " {set tags di
; set x
"+-"}
467 default
{set tags
{}}
469 set line
[string replace
$line 0 1 $x]
471 $ui_diff insert end
$line $tags
472 $ui_diff insert end
"\n"
473 $ui_diff conf
-state disabled
480 set ui_status_value
{Ready.
}
484 ######################################################################
488 proc load_last_commit
{} {
489 global HEAD PARENT commit_type ui_comm
491 if {$commit_type == {amend
}} return
492 if {$commit_type != {normal
}} {
493 error_popup
"Can't amend a $commit_type commit."
501 set fd
[open
"| git cat-file commit $HEAD" r
]
502 while {[gets
$fd line
] > 0} {
503 if {[string match
{parent
*} $line]} {
504 set parent
[string range
$line 7 end
]
508 set msg
[string trim
[read $fd]]
511 error_popup
"Error loading commit data for amend:\n$err"
515 if {$parent_count == 0} {
516 set commit_type amend
520 } elseif
{$parent_count == 1} {
521 set commit_type amend
523 $ui_comm delete
0.0 end
524 $ui_comm insert end
$msg
525 $ui_comm edit modified false
529 error_popup
{You can
't amend a merge commit.}
534 proc commit_tree {} {
535 global tcl_platform HEAD gitdir commit_type file_states
536 global commit_active ui_status_value
539 if {$commit_active || ![lock_index update]} return
541 # -- Our in memory state should match the repository.
543 repository_state curHEAD cur_type
544 if {$commit_type == {amend}
545 && $cur_type == {normal}
546 && $curHEAD == $HEAD} {
547 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
548 error_popup {Last scanned state does not match repository state.
550 Its highly likely that another Git program modified the
551 repository since our last scan. A rescan is required
559 # -- At least one file should differ in the index.
562 foreach path [array names file_states] {
563 set s $file_states($path)
564 switch -glob -- [lindex $s 0] {
568 M* {set files_ready 1; break}
570 error_popup "Unmerged files cannot be committed.
572 File [escape_path $path] has merge conflicts.
573 You must resolve them and include the file before committing.
579 error_popup "Unknown file state [lindex $s 0] detected.
581 File [escape_path $path] cannot be committed by this program.
587 error_popup {No included files to commit.
589 You must include at least 1 file before you can commit.
595 # -- A message is required.
597 set msg [string trim [$ui_comm get 1.0 end]]
599 error_popup {Please supply a commit message.
601 A good commit message has the following format:
603 - First line: Describe in one sentance what you did.
605 - Remaining lines: Describe why this change is good.
611 # -- Ask the pre-commit hook for the go-ahead.
613 set pchook [file join $gitdir hooks pre-commit]
614 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
615 set pchook [list sh -c \
616 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
617 } elseif {[file executable $pchook]} {
618 set pchook [list $pchook]
622 if {$pchook != {} && [catch {eval exec $pchook} err]} {
623 hook_failed_popup pre-commit $err
628 # -- Write the tree in the background.
631 set ui_status_value {Committing changes...}
633 set fd_wt [open "| git write-tree" r]
634 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
637 proc commit_stage2 {fd_wt curHEAD msg} {
638 global single_commit gitdir PARENT commit_type
639 global commit_active ui_status_value ui_comm
644 if {$tree_id == {}} {
645 error_popup "write-tree failed"
647 set ui_status_value {Commit failed.}
652 # -- Create the commit.
654 set cmd [list git commit-tree $tree_id]
656 lappend cmd -p $PARENT
658 if {$commit_type == {merge}} {
660 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
661 while {[gets $fd_mh merge_head] >= 0} {
662 lappend cmd -p $merge_head
666 error_popup "Loading MERGE_HEADs failed:\n$err"
668 set ui_status_value {Commit failed.}
674 # git commit-tree writes to stderr during initial commit.
675 lappend cmd 2>/dev/null
678 if {[catch {set cmt_id [eval exec $cmd]} err]} {
679 error_popup "commit-tree failed:\n$err"
681 set ui_status_value {Commit failed.}
686 # -- Update the HEAD ref.
689 if {$commit_type != {normal}} {
690 append reflogm " ($commit_type)"
692 set i [string first "\n" $msg]
694 append reflogm {: } [string range $msg 0 [expr $i - 1]]
696 append reflogm {: } $msg
698 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
699 if {[catch {eval exec $cmd} err]} {
700 error_popup "update-ref failed:\n$err"
702 set ui_status_value {Commit failed.}
707 # -- Cleanup after ourselves.
709 catch {file delete [file join $gitdir MERGE_HEAD]}
710 catch {file delete [file join $gitdir MERGE_MSG]}
711 catch {file delete [file join $gitdir SQUASH_MSG]}
712 catch {file delete [file join $gitdir GITGUI_MSG]}
714 # -- Let rerere do its thing.
716 if {[file isdirectory [file join $gitdir rr-cache]]} {
717 catch {exec git rerere}
720 $ui_comm delete 0.0 end
721 $ui_comm edit modified false
724 if {$single_commit} do_quit
731 update_status "Changes committed as [string range $cmt_id 0 7]."
734 ######################################################################
738 proc fetch_from {remote} {
739 set w [new_console "fetch $remote" \
740 "Fetching new changes from $remote"]
741 set cmd [list git fetch]
746 proc pull_remote {remote branch} {
747 global HEAD commit_type
750 if {![lock_index update]} return
752 # -- Our in memory state should match the repository.
754 repository_state curHEAD cur_type
755 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
756 error_popup {Last scanned state does not match repository state.
758 Its highly likely that another Git program modified the
759 repository since our last scan. A rescan is required
760 before a pull can be started.
767 # -- No differences should exist before a pull.
769 if {[array size file_states] != 0} {
770 error_popup {Uncommitted but modified files are present.
772 You should not perform a pull with unmodified files in your working
773 directory as Git would be unable to recover from an incorrect merge.
775 Commit or throw away all changes before starting a pull operation.
781 set w [new_console "pull $remote $branch" \
782 "Pulling new changes from branch $branch in $remote"]
783 set cmd [list git pull]
786 console_exec $w $cmd [list post_pull_remote $remote $branch]
789 proc post_pull_remote {remote branch success} {
790 global HEAD PARENT commit_type
791 global ui_status_value
795 repository_state HEAD commit_type
797 set $ui_status_value {Ready.}
799 update_status "Conflicts detected while pulling $branch from $remote."
803 proc push_to {remote} {
804 set w [new_console "push $remote" \
805 "Pushing changes to $remote"]
806 set cmd [list git push]
811 ######################################################################
815 proc mapcol {state path} {
816 global all_cols ui_other
818 if {[catch {set r $all_cols($state)}]} {
819 puts "error: no column for state={$state} $path"
825 proc mapicon {state path} {
828 if {[catch {set r $all_icons($state)}]} {
829 puts "error: no icon for state={$state} $path"
835 proc mapdesc {state path} {
838 if {[catch {set r $all_descs($state)}]} {
839 puts "error: no desc for state={$state} $path"
845 proc escape_path {path} {
846 regsub -all "\n" $path "\\n" path
852 proc merge_state {path new_state} {
853 global file_states next_icon_id
855 set s0 [string index $new_state 0]
856 set s1 [string index $new_state 1]
858 if {[catch {set info $file_states($path)}]} {
860 set icon n[incr next_icon_id]
862 set state [lindex $info 0]
863 set icon [lindex $info 1]
867 set s0 [string index $state 0]
868 } elseif {$s0 == {*}} {
873 set s1 [string index $state 1]
874 } elseif {$s1 == {*}} {
878 set file_states($path) [list $s0$s1 $icon]
882 proc display_file {path state} {
883 global ui_index ui_other
884 global file_states file_lists status_active
886 set old_m [merge_state $path $state]
887 if {$status_active} return
889 set s $file_states($path)
890 set new_m [lindex $s 0]
891 set new_w [mapcol $new_m $path]
892 set old_w [mapcol $old_m $path]
893 set new_icon [mapicon $new_m $path]
895 if {$new_w != $old_w} {
896 set lno [lsearch -sorted $file_lists($old_w) $path]
899 $old_w conf -state normal
900 $old_w delete $lno.0 [expr $lno + 1].0
901 $old_w conf -state disabled
904 lappend file_lists($new_w) $path
905 set file_lists($new_w) [lsort $file_lists($new_w)]
906 set lno [lsearch -sorted $file_lists($new_w) $path]
908 $new_w conf -state normal
909 $new_w image create $lno.0 \
910 -align center -padx 5 -pady 1 \
911 -name [lindex $s 1] \
913 $new_w insert $lno.1 "[escape_path $path]\n"
914 $new_w conf -state disabled
915 } elseif {$new_icon != [mapicon $old_m $path]} {
916 $new_w conf -state normal
917 $new_w image conf [lindex $s 1] -image $new_icon
918 $new_w conf -state disabled
922 proc display_all_files {} {
923 global ui_index ui_other file_states file_lists
925 $ui_index conf -state normal
926 $ui_other conf -state normal
928 foreach path [lsort [array names file_states]] {
929 set s $file_states($path)
931 set w [mapcol $m $path]
932 lappend file_lists($w) $path
933 $w image create end \
934 -align center -padx 5 -pady 1 \
935 -name [lindex $s 1] \
936 -image [mapicon $m $path]
937 $w insert end "[escape_path $path]\n"
940 $ui_index conf -state disabled
941 $ui_other conf -state disabled
944 proc with_update_index {body} {
945 global update_index_fd
947 if {$update_index_fd == {}} {
948 if {![lock_index update]} return
949 set update_index_fd [open \
950 "| git update-index --add --remove -z --stdin" \
952 fconfigure $update_index_fd -translation binary
954 close $update_index_fd
955 set update_index_fd {}
962 proc update_index {path} {
963 global update_index_fd
965 if {$update_index_fd == {}} {
966 error {not in with_update_index}
968 puts -nonewline $update_index_fd "$path\0"
972 proc toggle_mode {path} {
973 global file_states ui_fname_value
975 set s $file_states($path)
988 with_update_index {update_index $path}
989 display_file $path $new
990 if {$ui_fname_value == $path} {
995 ######################################################################
999 proc load_all_remotes {} {
1000 global gitdir all_remotes repo_config
1002 set all_remotes [list]
1003 set rm_dir [file join $gitdir remotes]
1004 if {[file isdirectory $rm_dir]} {
1005 set all_remotes [concat $all_remotes [glob \
1009 -directory $rm_dir *]]
1012 foreach line [array names repo_config remote.*.url] {
1013 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1014 lappend all_remotes $name
1018 set all_remotes [lsort -unique $all_remotes]
1021 proc populate_remote_menu {m pfx op} {
1022 global all_remotes mainfont
1024 foreach remote $all_remotes {
1025 $m add command -label "$pfx $remote..." \
1026 -command [list $op $remote] \
1031 proc populate_pull_menu {m} {
1032 global gitdir repo_config all_remotes mainfont disable_on_lock
1034 foreach remote $all_remotes {
1036 if {[array get repo_config remote.$remote.url] != {}} {
1037 if {[array get repo_config remote.$remote.fetch] != {}} {
1038 regexp {^([^:]+):} \
1039 [lindex $repo_config(remote.$remote.fetch) 0] \
1044 set fd [open [file join $gitdir remotes $remote] r]
1045 while {[gets $fd line] >= 0} {
1046 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1055 regsub ^refs/heads/ $rb {} rb_short
1056 if {$rb_short != {}} {
1058 -label "Branch $rb_short from $remote..." \
1059 -command [list pull_remote $remote $rb] \
1061 lappend disable_on_lock \
1062 [list $m entryconf [$m index last] -state]
1067 ######################################################################
1072 #define mask_width 14
1073 #define mask_height 15
1074 static unsigned char mask_bits[] = {
1075 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1076 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1077 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1080 image create bitmap file_plain -background white -foreground black -data {
1081 #define plain_width 14
1082 #define plain_height 15
1083 static unsigned char plain_bits[] = {
1084 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1085 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1086 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1087 } -maskdata $filemask
1089 image create bitmap file_mod -background white -foreground blue -data {
1090 #define mod_width 14
1091 #define mod_height 15
1092 static unsigned char mod_bits[] = {
1093 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1094 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1095 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1096 } -maskdata $filemask
1098 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1099 #define file_fulltick_width 14
1100 #define file_fulltick_height 15
1101 static unsigned char file_fulltick_bits[] = {
1102 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1103 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1104 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1105 } -maskdata $filemask
1107 image create bitmap file_parttick -background white -foreground "#005050" -data {
1108 #define parttick_width 14
1109 #define parttick_height 15
1110 static unsigned char parttick_bits[] = {
1111 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1112 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1113 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1114 } -maskdata $filemask
1116 image create bitmap file_question -background white -foreground black -data {
1117 #define file_question_width 14
1118 #define file_question_height 15
1119 static unsigned char file_question_bits[] = {
1120 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1121 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1122 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1123 } -maskdata $filemask
1125 image create bitmap file_removed -background white -foreground red -data {
1126 #define file_removed_width 14
1127 #define file_removed_height 15
1128 static unsigned char file_removed_bits[] = {
1129 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1130 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1131 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1132 } -maskdata $filemask
1134 image create bitmap file_merge -background white -foreground blue -data {
1135 #define file_merge_width 14
1136 #define file_merge_height 15
1137 static unsigned char file_merge_bits[] = {
1138 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1139 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1140 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1141 } -maskdata $filemask
1143 set ui_index .vpane.files.index.list
1144 set ui_other .vpane.files.other.list
1145 set max_status_desc 0
1147 {__ i plain "Unmodified"}
1148 {_M i mod "Modified"}
1149 {M_ i fulltick "Checked in"}
1150 {MM i parttick "Partially included"}
1152 {_O o plain "Untracked"}
1153 {A_ o fulltick "Added"}
1154 {AM o parttick "Partially added"}
1155 {AD o question "Added (but now gone)"}
1157 {_D i question "Missing"}
1158 {D_ i removed "Removed"}
1159 {DD i removed "Removed"}
1160 {DO i removed "Removed (still exists)"}
1162 {UM i merge "Merge conflicts"}
1163 {U_ i merge "Merge conflicts"}
1165 if {$max_status_desc < [string length [lindex $i 3]]} {
1166 set max_status_desc [string length [lindex $i 3]]
1168 if {[lindex $i 1] == {i}} {
1169 set all_cols([lindex $i 0]) $ui_index
1171 set all_cols([lindex $i 0]) $ui_other
1173 set all_icons([lindex $i 0]) file_[lindex $i 2]
1174 set all_descs([lindex $i 0]) [lindex $i 3]
1178 ######################################################################
1182 proc error_popup {msg} {
1189 proc show_msg {w top msg} {
1190 global gitdir appname mainfont
1192 message $w.m -text $msg -justify left -aspect 400
1193 pack $w.m -side top -fill x -padx 5 -pady 10
1194 button $w.ok -text OK \
1197 -command "destroy $top"
1198 pack $w.ok -side bottom
1199 bind $top <Visibility> "grab $top; focus $top"
1200 bind $top <Key-Return> "destroy $top"
1201 wm title $w "$appname ([lindex [file split \
1202 [file normalize [file dirname $gitdir]]] \
1207 proc hook_failed_popup {hook msg} {
1208 global gitdir mainfont difffont appname
1215 label $w.m.l1 -text "$hook hook failed:" \
1218 -font [concat $mainfont bold]
1220 -background white -borderwidth 1 \
1222 -width 80 -height 10 \
1224 -yscrollcommand [list $w.m.sby set]
1226 -text {You must correct the above errors before committing.} \
1229 -font [concat $mainfont bold]
1230 scrollbar $w.m.sby -command [list $w.m.t yview]
1231 pack $w.m.l1 -side top -fill x
1232 pack $w.m.l2 -side bottom -fill x
1233 pack $w.m.sby -side right -fill y
1234 pack $w.m.t -side left -fill both -expand 1
1235 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1237 $w.m.t insert 1.0 $msg
1238 $w.m.t conf -state disabled
1240 button $w.ok -text OK \
1243 -command "destroy $w"
1244 pack $w.ok -side bottom
1246 bind $w <Visibility> "grab $w; focus $w"
1247 bind $w <Key-Return> "destroy $w"
1248 wm title $w "$appname ([lindex [file split \
1249 [file normalize [file dirname $gitdir]]] \
1254 set next_console_id 0
1256 proc new_console {short_title long_title} {
1257 global next_console_id console_data
1258 set w .console[incr next_console_id]
1259 set console_data($w) [list $short_title $long_title]
1260 return [console_init $w]
1263 proc console_init {w} {
1264 global console_cr console_data
1265 global gitdir appname mainfont difffont
1267 set console_cr($w) 1.0
1270 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1273 -font [concat $mainfont bold]
1275 -background white -borderwidth 1 \
1277 -width 80 -height 10 \
1280 -yscrollcommand [list $w.m.sby set]
1281 label $w.m.s -anchor w \
1283 -font [concat $mainfont bold]
1284 scrollbar $w.m.sby -command [list $w.m.t yview]
1285 pack $w.m.l1 -side top -fill x
1286 pack $w.m.s -side bottom -fill x
1287 pack $w.m.sby -side right -fill y
1288 pack $w.m.t -side left -fill both -expand 1
1289 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1291 button $w.ok -text {Running...} \
1295 -command "destroy $w"
1296 pack $w.ok -side bottom
1298 bind $w <Visibility> "focus $w"
1299 wm title $w "$appname ([lindex [file split \
1300 [file normalize [file dirname $gitdir]]] \
1301 end]): [lindex $console_data($w) 0]"
1305 proc console_exec {w cmd {after {}}} {
1308 # -- Windows tosses the enviroment when we exec our child.
1309 # But most users need that so we have to relogin. :-(
1311 if {$tcl_platform(platform) == {windows}} {
1312 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1315 # -- Tcl won't
let us redirect both stdout and stderr to
1316 # the same pipe. So pass it through cat...
1318 set cmd
[concat |
$cmd |
& cat]
1320 set fd_f
[open
$cmd r
]
1321 fconfigure
$fd_f -blocking 0 -translation binary
1322 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1325 proc console_read
{w fd after
} {
1326 global console_cr console_data
1330 if {![winfo exists
$w]} {console_init
$w}
1331 $w.m.t conf
-state normal
1333 set n
[string length
$buf]
1335 set cr
[string first
"\r" $buf $c]
1336 set lf
[string first
"\n" $buf $c]
1337 if {$cr < 0} {set cr
[expr $n + 1]}
1338 if {$lf < 0} {set lf
[expr $n + 1]}
1341 $w.m.t insert end
[string range
$buf $c $lf]
1342 set console_cr
($w) [$w.m.t index
{end
-1c}]
1346 $w.m.t delete
$console_cr($w) end
1347 $w.m.t insert end
"\n"
1348 $w.m.t insert end
[string range
$buf $c $cr]
1353 $w.m.t conf
-state disabled
1357 fconfigure
$fd -blocking 1
1359 if {[catch
{close
$fd}]} {
1360 if {![winfo exists
$w]} {console_init
$w}
1361 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1362 $w.ok conf
-text Close
1363 $w.ok conf
-state normal
1365 } elseif
{[winfo exists
$w]} {
1366 $w.m.s conf
-background green
-text {Success
}
1367 $w.ok conf
-text Close
1368 $w.ok conf
-state normal
1371 array
unset console_cr
$w
1372 array
unset console_data
$w
1374 uplevel
#0 $after $ok
1378 fconfigure
$fd -blocking 0
1381 ######################################################################
1385 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1388 global tcl_platform ui_status_value starting_gitk_msg
1390 set ui_status_value
$starting_gitk_msg
1392 if {$ui_status_value == $starting_gitk_msg} {
1393 set ui_status_value
{Ready.
}
1397 if {$tcl_platform(platform
) == {windows
}} {
1405 set w
[new_console
"repack" "Repacking the object database"]
1406 set cmd
[list git repack
]
1409 console_exec
$w $cmd
1413 global gitdir ui_comm
1415 set save
[file join $gitdir GITGUI_MSG
]
1416 set msg
[string trim
[$ui_comm get
0.0 end
]]
1417 if {[$ui_comm edit modified
] && $msg != {}} {
1419 set fd
[open
$save w
]
1420 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1423 } elseif
{$msg == {} && [file exists
$save]} {
1435 proc do_include_all
{} {
1436 global update_active ui_status_value
1438 if {$update_active ||
![lock_index begin-update
]} return
1441 set ui_status_value
{Including all modified files...
}
1444 foreach path
[array names file_states
] {
1445 set s
$file_states($path)
1451 _D
{toggle_mode
$path}
1456 set ui_status_value
{Ready.
}
1460 proc do_signoff
{} {
1461 global ui_comm GIT_COMMITTER_IDENT
1463 if {$GIT_COMMITTER_IDENT == {}} {
1464 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1465 error_popup
"Unable to obtain your identity:\n$err"
1468 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1469 $me me GIT_COMMITTER_IDENT
]} {
1470 error_popup
"Invalid GIT_COMMITTER_IDENT:\n$me"
1475 set str
"Signed-off-by: $GIT_COMMITTER_IDENT"
1476 if {[$ui_comm get
{end
-1c linestart
} {end
-1c}] != $str} {
1477 $ui_comm edit separator
1478 $ui_comm insert end
"\n$str"
1479 $ui_comm edit separator
1484 proc do_amend_last
{} {
1492 # shift == 1: left click
1494 proc click
{w x y
shift wx wy
} {
1495 global ui_index ui_other file_lists
1497 set pos
[split [$w index @
$x,$y] .
]
1498 set lno
[lindex
$pos 0]
1499 set col [lindex
$pos 1]
1500 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1501 if {$path == {}} return
1503 if {$col > 0 && $shift == 1} {
1504 show_diff
$path $w $lno
1508 proc unclick
{w x y
} {
1509 set pos
[split [$w index @
$x,$y] .
]
1510 set lno
[lindex
$pos 0]
1511 set col [lindex
$pos 1]
1512 set path
[$w get
$lno.1 $lno.end
]
1513 if {$path == {}} return
1520 ######################################################################
1524 set mainfont
{Helvetica
10}
1525 set difffont
{Courier
10}
1526 set maincursor
[. cget
-cursor]
1528 switch
-glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1529 windows
,* {set M1B Control
; set M1T Ctrl
}
1530 unix
,Darwin
{set M1B M1
; set M1T Cmd
}
1531 default
{set M1B M1
; set M1T M1
}
1535 menu .mbar
-tearoff 0
1536 .mbar add cascade
-label Project
-menu .mbar.project
1537 .mbar add cascade
-label Edit
-menu .mbar.edit
1538 .mbar add cascade
-label Commit
-menu .mbar.commit
1539 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1540 .mbar add cascade
-label Pull
-menu .mbar.pull
1541 .mbar add cascade
-label Push
-menu .mbar.push
1542 .mbar add cascade
-label Options
-menu .mbar.options
1543 . configure
-menu .mbar
1547 .mbar.project add
command -label Visualize \
1550 .mbar.project add
command -label {Repack Database
} \
1551 -command do_repack \
1553 .mbar.project add
command -label Quit \
1555 -accelerator $M1T-Q \
1561 .mbar.edit add
command -label Undo \
1562 -command {catch
{[focus
] edit undo
}} \
1563 -accelerator $M1T-Z \
1565 .mbar.edit add
command -label Redo \
1566 -command {catch
{[focus
] edit redo
}} \
1567 -accelerator $M1T-Y \
1569 .mbar.edit add separator
1570 .mbar.edit add
command -label Cut \
1571 -command {catch
{tk_textCut
[focus
]}} \
1572 -accelerator $M1T-X \
1574 .mbar.edit add
command -label Copy \
1575 -command {catch
{tk_textCopy
[focus
]}} \
1576 -accelerator $M1T-C \
1578 .mbar.edit add
command -label Paste \
1579 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1580 -accelerator $M1T-V \
1582 .mbar.edit add
command -label Delete \
1583 -command {catch
{[focus
] delete sel.first sel.last
}} \
1586 .mbar.edit add separator
1587 .mbar.edit add
command -label {Select All
} \
1588 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1589 -accelerator $M1T-A \
1594 .mbar.commit add
command -label Rescan \
1595 -command do_rescan \
1598 lappend disable_on_lock \
1599 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1600 .mbar.commit add
command -label {Amend Last Commit
} \
1601 -command do_amend_last \
1603 lappend disable_on_lock \
1604 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1605 .mbar.commit add
command -label {Include All Files
} \
1606 -command do_include_all \
1607 -accelerator $M1T-I \
1609 lappend disable_on_lock \
1610 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1611 .mbar.commit add
command -label {Sign Off
} \
1612 -command do_signoff \
1613 -accelerator $M1T-S \
1615 .mbar.commit add
command -label Commit \
1616 -command do_commit \
1617 -accelerator $M1T-Return \
1619 lappend disable_on_lock \
1620 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1633 .mbar.options add checkbutton \
1634 -label {Trust File Modification Timestamps
} \
1637 -variable cfg_trust_mtime
1639 # -- Main Window Layout
1640 panedwindow .vpane
-orient vertical
1641 panedwindow .vpane.files
-orient horizontal
1642 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
1643 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1645 # -- Index File List
1646 frame .vpane.files.index
-height 100 -width 400
1647 label .vpane.files.index.title
-text {Modified Files
} \
1650 text
$ui_index -background white
-borderwidth 0 \
1651 -width 40 -height 10 \
1653 -yscrollcommand {.vpane.files.index.sb
set} \
1654 -cursor $maincursor \
1656 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
1657 pack .vpane.files.index.title
-side top
-fill x
1658 pack .vpane.files.index.sb
-side right
-fill y
1659 pack
$ui_index -side left
-fill both
-expand 1
1660 .vpane.files add .vpane.files.index
-sticky nsew
1662 # -- Other (Add) File List
1663 frame .vpane.files.other
-height 100 -width 100
1664 label .vpane.files.other.title
-text {Untracked Files
} \
1667 text
$ui_other -background white
-borderwidth 0 \
1668 -width 40 -height 10 \
1670 -yscrollcommand {.vpane.files.other.sb
set} \
1671 -cursor $maincursor \
1673 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
1674 pack .vpane.files.other.title
-side top
-fill x
1675 pack .vpane.files.other.sb
-side right
-fill y
1676 pack
$ui_other -side left
-fill both
-expand 1
1677 .vpane.files add .vpane.files.other
-sticky nsew
1679 $ui_index tag conf in_diff
-font [concat
$mainfont bold
]
1680 $ui_other tag conf in_diff
-font [concat
$mainfont bold
]
1682 # -- Diff and Commit Area
1683 frame .vpane.lower
-height 400 -width 400
1684 frame .vpane.lower.commarea
1685 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1686 pack .vpane.lower.commarea
-side top
-fill x
1687 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1688 .vpane add .vpane.lower
-stick nsew
1690 # -- Commit Area Buttons
1691 frame .vpane.lower.commarea.buttons
1692 label .vpane.lower.commarea.buttons.l
-text {} \
1696 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1697 pack .vpane.lower.commarea.buttons
-side left
-fill y
1699 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1700 -command do_rescan \
1702 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1703 lappend disable_on_lock
{.vpane.lower.commarea.buttons.rescan conf
-state}
1705 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
1706 -command do_amend_last \
1708 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
1709 lappend disable_on_lock
{.vpane.lower.commarea.buttons.amend conf
-state}
1711 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
1712 -command do_include_all \
1714 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
1715 lappend disable_on_lock
{.vpane.lower.commarea.buttons.incall conf
-state}
1717 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1718 -command do_signoff \
1720 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1722 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1723 -command do_commit \
1725 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1726 lappend disable_on_lock
{.vpane.lower.commarea.buttons.commit conf
-state}
1728 # -- Commit Message Buffer
1729 frame .vpane.lower.commarea.buffer
1730 set ui_comm .vpane.lower.commarea.buffer.t
1731 set ui_coml .vpane.lower.commarea.buffer.l
1732 label
$ui_coml -text {Commit Message
:} \
1736 trace add variable commit_type
write {uplevel
#0 {
1737 switch
-glob $commit_type \
1738 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
1739 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
1740 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
1741 * {$ui_coml conf
-text {Commit Message
:}}
1743 text
$ui_comm -background white
-borderwidth 1 \
1746 -autoseparators true \
1748 -width 75 -height 9 -wrap none \
1750 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set} \
1752 scrollbar .vpane.lower.commarea.buffer.sby
-command [list
$ui_comm yview
]
1753 pack
$ui_coml -side top
-fill x
1754 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1755 pack
$ui_comm -side left
-fill y
1756 pack .vpane.lower.commarea.buffer
-side left
-fill y
1759 set ui_fname_value
{}
1760 set ui_fstatus_value
{}
1761 frame .vpane.lower.
diff.header
-background orange
1762 label .vpane.lower.
diff.header.l1
-text {File
:} \
1763 -background orange \
1765 label .vpane.lower.
diff.header.l2
-textvariable ui_fname_value \
1766 -background orange \
1770 label .vpane.lower.
diff.header.l3
-text {Status
:} \
1771 -background orange \
1773 label .vpane.lower.
diff.header.l4
-textvariable ui_fstatus_value \
1774 -background orange \
1775 -width $max_status_desc \
1779 pack .vpane.lower.
diff.header.l1
-side left
1780 pack .vpane.lower.
diff.header.l2
-side left
-fill x
1781 pack .vpane.lower.
diff.header.l4
-side right
1782 pack .vpane.lower.
diff.header.l3
-side right
1785 frame .vpane.lower.
diff.body
1786 set ui_diff .vpane.lower.
diff.body.t
1787 text
$ui_diff -background white
-borderwidth 0 \
1788 -width 80 -height 15 -wrap none \
1790 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
1791 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
1792 -cursor $maincursor \
1794 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
1795 -command [list
$ui_diff xview
]
1796 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
1797 -command [list
$ui_diff yview
]
1798 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
1799 pack .vpane.lower.
diff.body.sby
-side right
-fill y
1800 pack
$ui_diff -side left
-fill both
-expand 1
1801 pack .vpane.lower.
diff.header
-side top
-fill x
1802 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
1804 $ui_diff tag conf dm
-foreground red
1805 $ui_diff tag conf dp
-foreground blue
1806 $ui_diff tag conf da
-font [concat
$difffont bold
]
1807 $ui_diff tag conf di
-foreground "#00a000"
1808 $ui_diff tag conf dni
-foreground "#a000a0"
1809 $ui_diff tag conf bold
-font [concat
$difffont bold
]
1812 set ui_status_value
{Initializing...
}
1813 label .status
-textvariable ui_status_value \
1819 pack .status
-anchor w
-side bottom
-fill x
1823 wm geometry .
[lindex
$repo_config(gui.geometry
) 0 0]
1824 eval .vpane sash place
0 [lindex
$repo_config(gui.geometry
) 0 1]
1825 eval .vpane.files sash place
0 [lindex
$repo_config(gui.geometry
) 0 2]
1829 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
1830 bind $ui_comm <$M1B-Key-i> {do_include_all
;break}
1831 bind $ui_comm <$M1B-Key-I> {do_include_all
;break}
1832 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
1833 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
1834 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
1835 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
1836 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
1837 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
1838 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
1839 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
1841 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
1842 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
1843 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
1844 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
1845 bind $ui_diff <$M1B-Key-v> {break}
1846 bind $ui_diff <$M1B-Key-V> {break}
1847 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
1848 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
1849 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
1850 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
1851 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
1852 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
1854 bind .
<Destroy
> do_quit
1855 bind all
<Key-F5
> do_rescan
1856 bind all
<$M1B-Key-r> do_rescan
1857 bind all
<$M1B-Key-R> do_rescan
1858 bind .
<$M1B-Key-s> do_signoff
1859 bind .
<$M1B-Key-S> do_signoff
1860 bind .
<$M1B-Key-i> do_include_all
1861 bind .
<$M1B-Key-I> do_include_all
1862 bind .
<$M1B-Key-Return> do_commit
1863 bind all
<$M1B-Key-q> do_quit
1864 bind all
<$M1B-Key-Q> do_quit
1865 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1866 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1867 foreach i
[list
$ui_index $ui_other] {
1868 bind $i <Button-1
> {click
%W
%x
%y
1 %X
%Y
; break}
1869 bind $i <Button-3
> {click
%W
%x
%y
3 %X
%Y
; break}
1870 bind $i <ButtonRelease-1
> {unclick
%W
%x
%y
; break}
1874 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
1875 focus
-force $ui_comm
1877 populate_remote_menu .mbar.fetch From fetch_from
1878 populate_remote_menu .mbar.push To push_to
1879 populate_pull_menu .mbar.pull