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 set appname
[lindex
[file split $argv0] end
]
13 ######################################################################
17 proc load_repo_config
{} {
19 global cfg_trust_mtime
21 array
unset repo_config
23 set fd_rc
[open
"| git repo-config --list" r
]
24 while {[gets
$fd_rc line
] >= 0} {
25 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
26 lappend repo_config
($name) $value
32 if {[catch
{set cfg_trust_mtime \
33 [lindex
$repo_config(gui.trustmtime
) 0]
35 set cfg_trust_mtime false
39 proc save_my_config
{} {
41 global cfg_trust_mtime
43 if {[catch
{set rc_trustMTime
$repo_config(gui.trustmtime
)}]} {
44 set rc_trustMTime
[list false
]
46 if {$cfg_trust_mtime != [lindex
$rc_trustMTime 0]} {
47 exec git repo-config gui.trustMTime
$cfg_trust_mtime
48 set repo_config
(gui.trustmtime
) [list
$cfg_trust_mtime]
51 set cfg_geometry
[wm geometry .
]
52 append cfg_geometry
" [lindex [.vpane sash coord 0] 1]"
53 append cfg_geometry
" [lindex [.vpane.files sash coord 0] 0]"
54 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
55 set rc_geometry
[list
[list
]]
57 if {$cfg_geometry != [lindex
$rc_geometry 0]} {
58 exec git repo-config gui.geometry
$cfg_geometry
59 set repo_config
(gui.geometry
) [list
$cfg_geometry]
63 proc error_popup
{msg
} {
69 append title
[lindex \
70 [file split [file normalize
[file dirname $gitdir]]] \
78 -title "$title: error" \
82 ######################################################################
86 if { [catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]
87 ||
[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
89 error_popup
"Cannot find the git directory:\n\n$err"
97 if {$appname == {git-citool
}} {
103 ######################################################################
112 set update_index_fd
{}
114 set disable_on_lock
[list
]
115 set index_lock_type none
121 proc lock_index
{type} {
122 global index_lock_type disable_on_lock
124 if {$index_lock_type == {none
}} {
125 set index_lock_type
$type
126 foreach w
$disable_on_lock {
127 uplevel
#0 $w disabled
130 } elseif
{$index_lock_type == {begin-update
} && $type == {update
}} {
131 set index_lock_type
$type
137 proc unlock_index
{} {
138 global index_lock_type disable_on_lock
140 set index_lock_type none
141 foreach w
$disable_on_lock {
146 ######################################################################
150 proc repository_state
{hdvar ctvar
} {
152 upvar
$hdvar hd
$ctvar ct
154 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
156 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
163 proc update_status
{{final Ready.
}} {
164 global HEAD PARENT commit_type
165 global ui_index ui_other ui_status_value ui_comm
166 global status_active file_states
167 global cfg_trust_mtime
169 if {$status_active ||
![lock_index
read]} return
171 repository_state new_HEAD new_type
172 if {$commit_type == {amend
}
173 && $new_type == {normal
}
174 && $new_HEAD == $HEAD} {
178 set commit_type
$new_type
181 array
unset file_states
183 if {![$ui_comm edit modified
]
184 ||
[string trim
[$ui_comm get
0.0 end
]] == {}} {
185 if {[load_message GITGUI_MSG
]} {
186 } elseif
{[load_message MERGE_MSG
]} {
187 } elseif
{[load_message SQUASH_MSG
]} {
189 $ui_comm edit modified false
193 if {$cfg_trust_mtime == {true
}} {
194 update_status_stage2
{} $final
197 set ui_status_value
{Refreshing
file status...
}
198 set fd_rf
[open
"| git update-index -q --unmerged --refresh" r
]
199 fconfigure
$fd_rf -blocking 0 -translation binary
200 fileevent
$fd_rf readable \
201 [list update_status_stage2
$fd_rf $final]
205 proc update_status_stage2
{fd final
} {
206 global gitdir PARENT commit_type
207 global ui_index ui_other ui_status_value ui_comm
209 global buf_rdi buf_rdf buf_rlo
213 if {![eof
$fd]} return
217 set ls_others
[list | git ls-files
--others -z \
218 --exclude-per-directory=.gitignore
]
219 set info_exclude
[file join $gitdir info exclude
]
220 if {[file readable
$info_exclude]} {
221 lappend ls_others
"--exclude-from=$info_exclude"
229 set ui_status_value
{Scanning
for modified files ...
}
230 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
231 set fd_df
[open
"| git diff-files -z" r
]
232 set fd_lo
[open
$ls_others r
]
234 fconfigure
$fd_di -blocking 0 -translation binary
235 fconfigure
$fd_df -blocking 0 -translation binary
236 fconfigure
$fd_lo -blocking 0 -translation binary
237 fileevent
$fd_di readable
[list read_diff_index
$fd_di $final]
238 fileevent
$fd_df readable
[list read_diff_files
$fd_df $final]
239 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $final]
242 proc load_message
{file} {
243 global gitdir ui_comm
245 set f
[file join $gitdir $file]
246 if {[file isfile
$f]} {
247 if {[catch
{set fd
[open
$f r
]}]} {
250 set content
[string trim
[read $fd]]
252 $ui_comm delete
0.0 end
253 $ui_comm insert end
$content
259 proc read_diff_index
{fd final
} {
262 append buf_rdi
[read $fd]
264 set n
[string length
$buf_rdi]
266 set z1
[string first
"\0" $buf_rdi $c]
269 set z2
[string first
"\0" $buf_rdi $z1]
275 [string range
$buf_rdi $z1 $z2] \
276 [string index
$buf_rdi [expr $z1 - 2]]_
280 set buf_rdi
[string range
$buf_rdi $c end
]
285 status_eof
$fd buf_rdi
$final
288 proc read_diff_files
{fd final
} {
291 append buf_rdf
[read $fd]
293 set n
[string length
$buf_rdf]
295 set z1
[string first
"\0" $buf_rdf $c]
298 set z2
[string first
"\0" $buf_rdf $z1]
304 [string range
$buf_rdf $z1 $z2] \
305 _
[string index
$buf_rdf [expr $z1 - 2]]
309 set buf_rdf
[string range
$buf_rdf $c end
]
314 status_eof
$fd buf_rdf
$final
317 proc read_ls_others
{fd final
} {
320 append buf_rlo
[read $fd]
321 set pck
[split $buf_rlo "\0"]
322 set buf_rlo
[lindex
$pck end
]
323 foreach p
[lrange
$pck 0 end-1
] {
326 status_eof
$fd buf_rlo
$final
329 proc status_eof
{fd buf final
} {
330 global status_active ui_status_value
337 if {[incr status_active
-1] == 0} {
341 set ui_status_value
$final
346 ######################################################################
351 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
353 $ui_diff conf
-state normal
354 $ui_diff delete
0.0 end
355 $ui_diff conf
-state disabled
357 set ui_fname_value
{}
358 set ui_fstatus_value
{}
360 $ui_index tag remove in_diff
0.0 end
361 $ui_other tag remove in_diff
0.0 end
364 proc reshow_diff
{} {
365 global ui_fname_value ui_status_value file_states
367 if {$ui_fname_value == {}
368 ||
[catch
{set s
$file_states($ui_fname_value)}]} {
371 show_diff
$ui_fname_value
375 proc show_diff
{path
{w
{}} {lno
{}}} {
376 global file_states file_lists
377 global PARENT diff_3way diff_active
378 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
380 if {$diff_active ||
![lock_index
read]} return
383 if {$w == {} ||
$lno == {}} {
384 foreach w
[array names file_lists
] {
385 set lno
[lsearch
-sorted $file_lists($w) $path]
392 if {$w != {} && $lno >= 1} {
393 $w tag add in_diff
$lno.0 [expr $lno + 1].0
396 set s
$file_states($path)
400 set ui_fname_value
[escape_path
$path]
401 set ui_fstatus_value
[mapdesc
$m $path]
402 set ui_status_value
"Loading diff of [escape_path $path]..."
404 set cmd
[list | git diff-index
-p $PARENT -- $path]
407 set cmd
[list | git diff-index
-p -c $PARENT $path]
411 set fd
[open
$path r
]
412 set content
[read $fd]
417 set ui_status_value
"Unable to display [escape_path $path]"
418 error_popup
"Error loading file:\n\n$err"
421 $ui_diff conf
-state normal
422 $ui_diff insert end
$content
423 $ui_diff conf
-state disabled
426 set ui_status_value
{Ready.
}
431 if {[catch
{set fd
[open
$cmd r
]} err
]} {
434 set ui_status_value
"Unable to display [escape_path $path]"
435 error_popup
"Error loading diff:\n\n$err"
439 fconfigure
$fd -blocking 0 -translation auto
440 fileevent
$fd readable
[list read_diff
$fd]
443 proc read_diff
{fd
} {
444 global ui_diff ui_status_value diff_3way diff_active
446 while {[gets
$fd line
] >= 0} {
447 if {[string match
{diff --git *} $line]} continue
448 if {[string match
{diff --combined *} $line]} continue
449 if {[string match
{--- *} $line]} continue
450 if {[string match
{+++ *} $line]} continue
451 if {[string match index
* $line]} {
452 if {[string first
, $line] >= 0} {
457 $ui_diff conf
-state normal
459 set x
[string index
$line 0]
464 default
{set tags
{}}
467 set x
[string range
$line 0 1]
469 default
{set tags
{}}
471 "++" {set tags dp
; set x
" +"}
472 " +" {set tags
{di bold
}; set x
"++"}
473 "+ " {set tags dni
; set x
"-+"}
474 "--" {set tags dm
; set x
" -"}
475 " -" {set tags
{dm bold
}; set x
"--"}
476 "- " {set tags di
; set x
"+-"}
477 default
{set tags
{}}
479 set line
[string replace
$line 0 1 $x]
481 $ui_diff insert end
$line $tags
482 $ui_diff insert end
"\n"
483 $ui_diff conf
-state disabled
490 set ui_status_value
{Ready.
}
494 ######################################################################
498 proc load_last_commit
{} {
499 global HEAD PARENT commit_type ui_comm
501 if {$commit_type == {amend
}} return
502 if {$commit_type != {normal
}} {
503 error_popup
"Can't amend a $commit_type commit."
511 set fd
[open
"| git cat-file commit $HEAD" r
]
512 while {[gets
$fd line
] > 0} {
513 if {[string match
{parent
*} $line]} {
514 set parent
[string range
$line 7 end
]
518 set msg
[string trim
[read $fd]]
521 error_popup
"Error loading commit data for amend:\n\n$err"
525 if {$parent_count == 0} {
526 set commit_type amend
530 } elseif
{$parent_count == 1} {
531 set commit_type amend
533 $ui_comm delete
0.0 end
534 $ui_comm insert end
$msg
535 $ui_comm edit modified false
539 error_popup
{You can
't amend a merge commit.}
544 proc commit_tree {} {
545 global tcl_platform HEAD gitdir commit_type file_states
546 global commit_active ui_status_value
549 if {$commit_active || ![lock_index update]} return
551 # -- Our in memory state should match the repository.
553 repository_state curHEAD cur_type
554 if {$commit_type == {amend}
555 && $cur_type == {normal}
556 && $curHEAD == $HEAD} {
557 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
558 error_popup {Last scanned state does not match repository state.
560 Its highly likely that another Git program modified the
561 repository since our last scan. A rescan is required
569 # -- At least one file should differ in the index.
572 foreach path [array names file_states] {
573 set s $file_states($path)
574 switch -glob -- [lindex $s 0] {
578 M? {set files_ready 1; break}
580 error_popup "Unmerged files cannot be committed.
582 File [escape_path $path] has merge conflicts.
583 You must resolve them and include the file before committing.
589 error_popup "Unknown file state [lindex $s 0] detected.
591 File [escape_path $path] cannot be committed by this program.
597 error_popup {No included files to commit.
599 You must include at least 1 file before you can commit.
605 # -- A message is required.
607 set msg [string trim [$ui_comm get 1.0 end]]
609 error_popup {Please supply a commit message.
611 A good commit message has the following format:
613 - First line: Describe in one sentance what you did.
615 - Remaining lines: Describe why this change is good.
621 # -- Ask the pre-commit hook for the go-ahead.
623 set pchook [file join $gitdir hooks pre-commit]
624 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
625 set pchook [list sh -c \
626 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
627 } elseif {[file executable $pchook]} {
628 set pchook [list $pchook]
632 if {$pchook != {} && [catch {eval exec $pchook} err]} {
633 hook_failed_popup pre-commit $err
638 # -- Write the tree in the background.
641 set ui_status_value {Committing changes...}
643 set fd_wt [open "| git write-tree" r]
644 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
647 proc commit_stage2 {fd_wt curHEAD msg} {
648 global single_commit gitdir HEAD PARENT commit_type
649 global commit_active ui_status_value ui_comm
653 if {$tree_id == {} || [catch {close $fd_wt} err]} {
654 error_popup "write-tree failed:\n\n$err"
656 set ui_status_value {Commit failed.}
661 # -- Create the commit.
663 set cmd [list git commit-tree $tree_id]
665 lappend cmd -p $PARENT
667 if {$commit_type == {merge}} {
669 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
670 while {[gets $fd_mh merge_head] >= 0} {
671 lappend cmd -p $merge_head
675 error_popup "Loading MERGE_HEAD failed:\n\n$err"
677 set ui_status_value {Commit failed.}
683 # git commit-tree writes to stderr during initial commit.
684 lappend cmd 2>/dev/null
687 if {[catch {set cmt_id [eval exec $cmd]} err]} {
688 error_popup "commit-tree failed:\n\n$err"
690 set ui_status_value {Commit failed.}
695 # -- Update the HEAD ref.
698 if {$commit_type != {normal}} {
699 append reflogm " ($commit_type)"
701 set i [string first "\n" $msg]
703 append reflogm {: } [string range $msg 0 [expr $i - 1]]
705 append reflogm {: } $msg
707 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
708 if {[catch {eval exec $cmd} err]} {
709 error_popup "update-ref failed:\n\n$err"
711 set ui_status_value {Commit failed.}
716 # -- Cleanup after ourselves.
718 catch {file delete [file join $gitdir MERGE_HEAD]}
719 catch {file delete [file join $gitdir MERGE_MSG]}
720 catch {file delete [file join $gitdir SQUASH_MSG]}
721 catch {file delete [file join $gitdir GITGUI_MSG]}
723 # -- Let rerere do its thing.
725 if {[file isdirectory [file join $gitdir rr-cache]]} {
726 catch {exec git rerere}
729 $ui_comm delete 0.0 end
730 $ui_comm edit modified false
733 if {$single_commit} do_quit
735 # -- Update status without invoking any git commands.
738 set commit_type normal
742 foreach path [array names file_states] {
743 set s $file_states($path)
748 D? {set m _[string index $m 1]}
752 unset file_states($path)
754 lset file_states($path) 0 $m
761 set ui_status_value \
762 "Changes committed as [string range $cmt_id 0 7]."
765 ######################################################################
769 proc fetch_from {remote} {
770 set w [new_console "fetch $remote" \
771 "Fetching new changes from $remote"]
772 set cmd [list git fetch]
777 proc pull_remote {remote branch} {
778 global HEAD commit_type
781 if {![lock_index update]} return
783 # -- Our in memory state should match the repository.
785 repository_state curHEAD cur_type
786 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
787 error_popup {Last scanned state does not match repository state.
789 Its highly likely that another Git program modified the
790 repository since our last scan. A rescan is required
791 before a pull can be started.
798 # -- No differences should exist before a pull.
800 if {[array size file_states] != 0} {
801 error_popup {Uncommitted but modified files are present.
803 You should not perform a pull with unmodified files in your working
804 directory as Git would be unable to recover from an incorrect merge.
806 Commit or throw away all changes before starting a pull operation.
812 set w [new_console "pull $remote $branch" \
813 "Pulling new changes from branch $branch in $remote"]
814 set cmd [list git pull]
817 console_exec $w $cmd [list post_pull_remote $remote $branch]
820 proc post_pull_remote {remote branch success} {
821 global HEAD PARENT commit_type
822 global ui_status_value
826 repository_state HEAD commit_type
828 set $ui_status_value {Ready.}
831 "Conflicts detected while pulling $branch from $remote."
835 proc push_to {remote} {
836 set w [new_console "push $remote" \
837 "Pushing changes to $remote"]
838 set cmd [list git push]
843 ######################################################################
847 proc mapcol {state path} {
848 global all_cols ui_other
850 if {[catch {set r $all_cols($state)}]} {
851 puts "error: no column for state={$state} $path"
857 proc mapicon {state path} {
860 if {[catch {set r $all_icons($state)}]} {
861 puts "error: no icon for state={$state} $path"
867 proc mapdesc {state path} {
870 if {[catch {set r $all_descs($state)}]} {
871 puts "error: no desc for state={$state} $path"
877 proc escape_path {path} {
878 regsub -all "\n" $path "\\n" path
884 proc merge_state {path new_state} {
885 global file_states next_icon_id
887 set s0 [string index $new_state 0]
888 set s1 [string index $new_state 1]
890 if {[catch {set info $file_states($path)}]} {
892 set icon n[incr next_icon_id]
894 set state [lindex $info 0]
895 set icon [lindex $info 1]
899 set s0 [string index $state 0]
900 } elseif {$s0 == {*}} {
905 set s1 [string index $state 1]
906 } elseif {$s1 == {*}} {
910 set file_states($path) [list $s0$s1 $icon]
914 proc display_file {path state} {
915 global ui_index ui_other
916 global file_states file_lists status_active
918 set old_m [merge_state $path $state]
919 if {$status_active} return
921 set s $file_states($path)
922 set new_m [lindex $s 0]
923 set new_w [mapcol $new_m $path]
924 set old_w [mapcol $old_m $path]
925 set new_icon [mapicon $new_m $path]
927 if {$new_w != $old_w} {
928 set lno [lsearch -sorted $file_lists($old_w) $path]
931 $old_w conf -state normal
932 $old_w delete $lno.0 [expr $lno + 1].0
933 $old_w conf -state disabled
936 lappend file_lists($new_w) $path
937 set file_lists($new_w) [lsort $file_lists($new_w)]
938 set lno [lsearch -sorted $file_lists($new_w) $path]
940 $new_w conf -state normal
941 $new_w image create $lno.0 \
942 -align center -padx 5 -pady 1 \
943 -name [lindex $s 1] \
945 $new_w insert $lno.1 "[escape_path $path]\n"
946 $new_w conf -state disabled
947 } elseif {$new_icon != [mapicon $old_m $path]} {
948 $new_w conf -state normal
949 $new_w image conf [lindex $s 1] -image $new_icon
950 $new_w conf -state disabled
954 proc display_all_files {} {
955 global ui_index ui_other file_states file_lists
957 $ui_index conf -state normal
958 $ui_other conf -state normal
960 $ui_index delete 0.0 end
961 $ui_other delete 0.0 end
963 set file_lists($ui_index) [list]
964 set file_lists($ui_other) [list]
966 foreach path [lsort [array names file_states]] {
967 set s $file_states($path)
969 set w [mapcol $m $path]
970 lappend file_lists($w) $path
971 $w image create end \
972 -align center -padx 5 -pady 1 \
973 -name [lindex $s 1] \
974 -image [mapicon $m $path]
975 $w insert end "[escape_path $path]\n"
978 $ui_index conf -state disabled
979 $ui_other conf -state disabled
982 proc with_update_index {body} {
983 global update_index_fd
985 if {$update_index_fd == {}} {
986 if {![lock_index update]} return
987 set update_index_fd [open \
988 "| git update-index --add --remove -z --stdin" \
990 fconfigure $update_index_fd -translation binary
992 close $update_index_fd
993 set update_index_fd {}
1000 proc update_index {path} {
1001 global update_index_fd
1003 if {$update_index_fd == {}} {
1004 error {not in with_update_index}
1006 puts -nonewline $update_index_fd "$path\0"
1010 proc toggle_mode {path} {
1011 global file_states ui_fname_value
1013 set s $file_states($path)
1026 with_update_index {update_index $path}
1027 display_file $path $new
1028 if {$ui_fname_value == $path} {
1033 ######################################################################
1035 ## remote management
1037 proc load_all_remotes {} {
1038 global gitdir all_remotes repo_config
1040 set all_remotes [list]
1041 set rm_dir [file join $gitdir remotes]
1042 if {[file isdirectory $rm_dir]} {
1043 set all_remotes [concat $all_remotes [glob \
1047 -directory $rm_dir *]]
1050 foreach line [array names repo_config remote.*.url] {
1051 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1052 lappend all_remotes $name
1056 set all_remotes [lsort -unique $all_remotes]
1059 proc populate_remote_menu {m pfx op} {
1060 global all_remotes font_ui
1062 foreach remote $all_remotes {
1063 $m add command -label "$pfx $remote..." \
1064 -command [list $op $remote] \
1069 proc populate_pull_menu {m} {
1070 global gitdir repo_config all_remotes font_ui disable_on_lock
1072 foreach remote $all_remotes {
1074 if {[array get repo_config remote.$remote.url] != {}} {
1075 if {[array get repo_config remote.$remote.fetch] != {}} {
1076 regexp {^([^:]+):} \
1077 [lindex $repo_config(remote.$remote.fetch) 0] \
1082 set fd [open [file join $gitdir remotes $remote] r]
1083 while {[gets $fd line] >= 0} {
1084 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1093 regsub ^refs/heads/ $rb {} rb_short
1094 if {$rb_short != {}} {
1096 -label "Branch $rb_short from $remote..." \
1097 -command [list pull_remote $remote $rb] \
1099 lappend disable_on_lock \
1100 [list $m entryconf [$m index last] -state]
1105 ######################################################################
1110 #define mask_width 14
1111 #define mask_height 15
1112 static unsigned char mask_bits[] = {
1113 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1114 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1115 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1118 image create bitmap file_plain -background white -foreground black -data {
1119 #define plain_width 14
1120 #define plain_height 15
1121 static unsigned char plain_bits[] = {
1122 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1123 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1124 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1125 } -maskdata $filemask
1127 image create bitmap file_mod -background white -foreground blue -data {
1128 #define mod_width 14
1129 #define mod_height 15
1130 static unsigned char mod_bits[] = {
1131 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1132 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1133 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1134 } -maskdata $filemask
1136 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1137 #define file_fulltick_width 14
1138 #define file_fulltick_height 15
1139 static unsigned char file_fulltick_bits[] = {
1140 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1141 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1142 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1143 } -maskdata $filemask
1145 image create bitmap file_parttick -background white -foreground "#005050" -data {
1146 #define parttick_width 14
1147 #define parttick_height 15
1148 static unsigned char parttick_bits[] = {
1149 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1150 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1151 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1152 } -maskdata $filemask
1154 image create bitmap file_question -background white -foreground black -data {
1155 #define file_question_width 14
1156 #define file_question_height 15
1157 static unsigned char file_question_bits[] = {
1158 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1159 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1160 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1161 } -maskdata $filemask
1163 image create bitmap file_removed -background white -foreground red -data {
1164 #define file_removed_width 14
1165 #define file_removed_height 15
1166 static unsigned char file_removed_bits[] = {
1167 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1168 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1169 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1170 } -maskdata $filemask
1172 image create bitmap file_merge -background white -foreground blue -data {
1173 #define file_merge_width 14
1174 #define file_merge_height 15
1175 static unsigned char file_merge_bits[] = {
1176 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1177 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1178 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1179 } -maskdata $filemask
1181 set ui_index .vpane.files.index.list
1182 set ui_other .vpane.files.other.list
1183 set max_status_desc 0
1185 {__ i plain "Unmodified"}
1186 {_M i mod "Modified"}
1187 {M_ i fulltick "Checked in"}
1188 {MM i parttick "Partially included"}
1190 {_O o plain "Untracked"}
1191 {A_ o fulltick "Added"}
1192 {AM o parttick "Partially added"}
1193 {AD o question "Added (but now gone)"}
1195 {_D i question "Missing"}
1196 {D_ i removed "Removed"}
1197 {DD i removed "Removed"}
1198 {DO i removed "Removed (still exists)"}
1200 {UM i merge "Merge conflicts"}
1201 {U_ i merge "Merge conflicts"}
1203 if {$max_status_desc < [string length [lindex $i 3]]} {
1204 set max_status_desc [string length [lindex $i 3]]
1206 if {[lindex $i 1] == {i}} {
1207 set all_cols([lindex $i 0]) $ui_index
1209 set all_cols([lindex $i 0]) $ui_other
1211 set all_icons([lindex $i 0]) file_[lindex $i 2]
1212 set all_descs([lindex $i 0]) [lindex $i 3]
1216 ######################################################################
1220 proc hook_failed_popup {hook msg} {
1221 global gitdir font_ui font_diff appname
1228 label $w.m.l1 -text "$hook hook failed:" \
1231 -font [concat $font_ui bold]
1233 -background white -borderwidth 1 \
1235 -width 80 -height 10 \
1237 -yscrollcommand [list $w.m.sby set]
1239 -text {You must correct the above errors before committing.} \
1242 -font [concat $font_ui bold]
1243 scrollbar $w.m.sby -command [list $w.m.t yview]
1244 pack $w.m.l1 -side top -fill x
1245 pack $w.m.l2 -side bottom -fill x
1246 pack $w.m.sby -side right -fill y
1247 pack $w.m.t -side left -fill both -expand 1
1248 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1250 $w.m.t insert 1.0 $msg
1251 $w.m.t conf -state disabled
1253 button $w.ok -text OK \
1256 -command "destroy $w"
1257 pack $w.ok -side bottom
1259 bind $w <Visibility> "grab $w; focus $w"
1260 bind $w <Key-Return> "destroy $w"
1261 wm title $w "$appname ([lindex [file split \
1262 [file normalize [file dirname $gitdir]]] \
1267 set next_console_id 0
1269 proc new_console {short_title long_title} {
1270 global next_console_id console_data
1271 set w .console[incr next_console_id]
1272 set console_data($w) [list $short_title $long_title]
1273 return [console_init $w]
1276 proc console_init {w} {
1277 global console_cr console_data
1278 global gitdir appname font_ui font_diff M1B
1280 set console_cr($w) 1.0
1283 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1286 -font [concat $font_ui bold]
1288 -background white -borderwidth 1 \
1290 -width 80 -height 10 \
1293 -yscrollcommand [list $w.m.sby set]
1294 label $w.m.s -anchor w \
1296 -font [concat $font_ui bold]
1297 scrollbar $w.m.sby -command [list $w.m.t yview]
1298 pack $w.m.l1 -side top -fill x
1299 pack $w.m.s -side bottom -fill x
1300 pack $w.m.sby -side right -fill y
1301 pack $w.m.t -side left -fill both -expand 1
1302 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1304 menu $w.ctxm -tearoff 0
1305 $w.ctxm add command -label "Copy" \
1307 -command "tk_textCopy $w.m.t"
1308 $w.ctxm add command -label "Select All" \
1310 -command "$w.m.t tag add sel 0.0 end"
1311 $w.ctxm add command -label "Copy All" \
1314 $w.m.t tag add sel 0.0 end
1316 $w.m.t tag remove sel 0.0 end
1319 button $w.ok -text {Running...} \
1323 -command "destroy $w"
1324 pack $w.ok -side bottom
1326 bind $w.m.t <Any-Button-3> "tk_popup $w.ctxm %X %Y"
1327 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1328 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1329 bind $w <Visibility> "focus $w"
1330 wm title $w "$appname ([lindex [file split \
1331 [file normalize [file dirname $gitdir]]] \
1332 end]): [lindex $console_data($w) 0]"
1336 proc console_exec {w cmd {after {}}} {
1339 # -- Windows tosses the enviroment when we exec our child.
1340 # But most users need that so we have to relogin. :-(
1342 if {$tcl_platform(platform) == {windows}} {
1343 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1346 # -- Tcl won't
let us redirect both stdout and stderr to
1347 # the same pipe. So pass it through cat...
1349 set cmd
[concat |
$cmd |
& cat]
1351 set fd_f
[open
$cmd r
]
1352 fconfigure
$fd_f -blocking 0 -translation binary
1353 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1356 proc console_read
{w fd after
} {
1357 global console_cr console_data
1361 if {![winfo exists
$w]} {console_init
$w}
1362 $w.m.t conf
-state normal
1364 set n
[string length
$buf]
1366 set cr
[string first
"\r" $buf $c]
1367 set lf
[string first
"\n" $buf $c]
1368 if {$cr < 0} {set cr
[expr $n + 1]}
1369 if {$lf < 0} {set lf
[expr $n + 1]}
1372 $w.m.t insert end
[string range
$buf $c $lf]
1373 set console_cr
($w) [$w.m.t index
{end
-1c}]
1377 $w.m.t delete
$console_cr($w) end
1378 $w.m.t insert end
"\n"
1379 $w.m.t insert end
[string range
$buf $c $cr]
1384 $w.m.t conf
-state disabled
1388 fconfigure
$fd -blocking 1
1390 if {[catch
{close
$fd}]} {
1391 if {![winfo exists
$w]} {console_init
$w}
1392 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1393 $w.ok conf
-text Close
1394 $w.ok conf
-state normal
1396 } elseif
{[winfo exists
$w]} {
1397 $w.m.s conf
-background green
-text {Success
}
1398 $w.ok conf
-text Close
1399 $w.ok conf
-state normal
1402 array
unset console_cr
$w
1403 array
unset console_data
$w
1405 uplevel
#0 $after $ok
1409 fconfigure
$fd -blocking 0
1412 ######################################################################
1416 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1419 global tcl_platform ui_status_value starting_gitk_msg
1421 set ui_status_value
$starting_gitk_msg
1423 if {$ui_status_value == $starting_gitk_msg} {
1424 set ui_status_value
{Ready.
}
1428 if {$tcl_platform(platform
) == {windows
}} {
1436 set w
[new_console
"repack" "Repacking the object database"]
1437 set cmd
[list git repack
]
1440 console_exec
$w $cmd
1446 global gitdir ui_comm quitting
1448 if {$quitting} return
1451 set save
[file join $gitdir GITGUI_MSG
]
1452 set msg
[string trim
[$ui_comm get
0.0 end
]]
1453 if {[$ui_comm edit modified
] && $msg != {}} {
1455 set fd
[open
$save w
]
1456 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1459 } elseif
{$msg == {} && [file exists
$save]} {
1471 proc do_include_all
{} {
1472 global update_active ui_status_value
1474 if {$update_active ||
![lock_index begin-update
]} return
1477 set ui_status_value
{Including all modified files...
}
1480 foreach path
[array names file_states
] {
1481 set s
$file_states($path)
1487 _D
{toggle_mode
$path}
1492 set ui_status_value
{Ready.
}
1496 set GIT_COMMITTER_IDENT
{}
1498 proc do_signoff
{} {
1499 global ui_comm GIT_COMMITTER_IDENT
1501 if {$GIT_COMMITTER_IDENT == {}} {
1502 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1503 error_popup
"Unable to obtain your identity:\n\n$err"
1506 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1507 $me me GIT_COMMITTER_IDENT
]} {
1508 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1513 set str
"Signed-off-by: $GIT_COMMITTER_IDENT"
1514 if {[$ui_comm get
{end
-1c linestart
} {end
-1c}] != $str} {
1515 $ui_comm edit separator
1516 $ui_comm insert end
"\n$str"
1517 $ui_comm edit separator
1522 proc do_amend_last
{} {
1530 # shift == 1: left click
1532 proc click
{w x y
shift wx wy
} {
1533 global ui_index ui_other file_lists
1535 set pos
[split [$w index @
$x,$y] .
]
1536 set lno
[lindex
$pos 0]
1537 set col [lindex
$pos 1]
1538 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1539 if {$path == {}} return
1541 if {$col > 0 && $shift == 1} {
1542 show_diff
$path $w $lno
1546 proc unclick
{w x y
} {
1549 set pos
[split [$w index @
$x,$y] .
]
1550 set lno
[lindex
$pos 0]
1551 set col [lindex
$pos 1]
1552 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1553 if {$path == {}} return
1560 ######################################################################
1564 set font_ui
{Helvetica
10}
1565 set font_diff
{Courier
10}
1566 set maincursor
[. cget
-cursor]
1568 switch
-glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1569 windows
,* {set M1B Control
; set M1T Ctrl
}
1570 unix
,Darwin
{set M1B M1
; set M1T Cmd
}
1571 * {set M1B M1
; set M1T M1
}
1575 menu .mbar
-tearoff 0
1576 .mbar add cascade
-label Project
-menu .mbar.project
1577 .mbar add cascade
-label Edit
-menu .mbar.edit
1578 .mbar add cascade
-label Commit
-menu .mbar.commit
1579 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1580 .mbar add cascade
-label Pull
-menu .mbar.pull
1581 .mbar add cascade
-label Push
-menu .mbar.push
1582 .mbar add cascade
-label Options
-menu .mbar.options
1583 . configure
-menu .mbar
1587 .mbar.project add
command -label Visualize \
1590 .mbar.project add
command -label {Repack Database
} \
1591 -command do_repack \
1593 .mbar.project add
command -label Quit \
1595 -accelerator $M1T-Q \
1601 .mbar.edit add
command -label Undo \
1602 -command {catch
{[focus
] edit undo
}} \
1603 -accelerator $M1T-Z \
1605 .mbar.edit add
command -label Redo \
1606 -command {catch
{[focus
] edit redo
}} \
1607 -accelerator $M1T-Y \
1609 .mbar.edit add separator
1610 .mbar.edit add
command -label Cut \
1611 -command {catch
{tk_textCut
[focus
]}} \
1612 -accelerator $M1T-X \
1614 .mbar.edit add
command -label Copy \
1615 -command {catch
{tk_textCopy
[focus
]}} \
1616 -accelerator $M1T-C \
1618 .mbar.edit add
command -label Paste \
1619 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1620 -accelerator $M1T-V \
1622 .mbar.edit add
command -label Delete \
1623 -command {catch
{[focus
] delete sel.first sel.last
}} \
1626 .mbar.edit add separator
1627 .mbar.edit add
command -label {Select All
} \
1628 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1629 -accelerator $M1T-A \
1634 .mbar.commit add
command -label Rescan \
1635 -command do_rescan \
1638 lappend disable_on_lock \
1639 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1640 .mbar.commit add
command -label {Amend Last Commit
} \
1641 -command do_amend_last \
1643 lappend disable_on_lock \
1644 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1645 .mbar.commit add
command -label {Include All Files
} \
1646 -command do_include_all \
1647 -accelerator $M1T-I \
1649 lappend disable_on_lock \
1650 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1651 .mbar.commit add
command -label {Sign Off
} \
1652 -command do_signoff \
1653 -accelerator $M1T-S \
1655 .mbar.commit add
command -label Commit \
1656 -command do_commit \
1657 -accelerator $M1T-Return \
1659 lappend disable_on_lock \
1660 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1673 .mbar.options add checkbutton \
1674 -label {Trust File Modification Timestamps
} \
1677 -variable cfg_trust_mtime
1679 # -- Main Window Layout
1680 panedwindow .vpane
-orient vertical
1681 panedwindow .vpane.files
-orient horizontal
1682 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
1683 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1685 # -- Index File List
1686 frame .vpane.files.index
-height 100 -width 400
1687 label .vpane.files.index.title
-text {Modified Files
} \
1690 text
$ui_index -background white
-borderwidth 0 \
1691 -width 40 -height 10 \
1693 -yscrollcommand {.vpane.files.index.sb
set} \
1694 -cursor $maincursor \
1696 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
1697 pack .vpane.files.index.title
-side top
-fill x
1698 pack .vpane.files.index.sb
-side right
-fill y
1699 pack
$ui_index -side left
-fill both
-expand 1
1700 .vpane.files add .vpane.files.index
-sticky nsew
1702 # -- Other (Add) File List
1703 frame .vpane.files.other
-height 100 -width 100
1704 label .vpane.files.other.title
-text {Untracked Files
} \
1707 text
$ui_other -background white
-borderwidth 0 \
1708 -width 40 -height 10 \
1710 -yscrollcommand {.vpane.files.other.sb
set} \
1711 -cursor $maincursor \
1713 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
1714 pack .vpane.files.other.title
-side top
-fill x
1715 pack .vpane.files.other.sb
-side right
-fill y
1716 pack
$ui_other -side left
-fill both
-expand 1
1717 .vpane.files add .vpane.files.other
-sticky nsew
1719 $ui_index tag conf in_diff
-font [concat
$font_ui bold
]
1720 $ui_other tag conf in_diff
-font [concat
$font_ui bold
]
1722 # -- Diff and Commit Area
1723 frame .vpane.lower
-height 400 -width 400
1724 frame .vpane.lower.commarea
1725 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1726 pack .vpane.lower.commarea
-side top
-fill x
1727 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1728 .vpane add .vpane.lower
-stick nsew
1730 # -- Commit Area Buttons
1731 frame .vpane.lower.commarea.buttons
1732 label .vpane.lower.commarea.buttons.l
-text {} \
1736 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1737 pack .vpane.lower.commarea.buttons
-side left
-fill y
1739 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1740 -command do_rescan \
1742 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1743 lappend disable_on_lock \
1744 {.vpane.lower.commarea.buttons.rescan conf
-state}
1746 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
1747 -command do_amend_last \
1749 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
1750 lappend disable_on_lock \
1751 {.vpane.lower.commarea.buttons.amend conf
-state}
1753 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
1754 -command do_include_all \
1756 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
1757 lappend disable_on_lock \
1758 {.vpane.lower.commarea.buttons.incall conf
-state}
1760 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1761 -command do_signoff \
1763 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1765 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1766 -command do_commit \
1768 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1769 lappend disable_on_lock \
1770 {.vpane.lower.commarea.buttons.commit conf
-state}
1772 # -- Commit Message Buffer
1773 frame .vpane.lower.commarea.buffer
1774 set ui_comm .vpane.lower.commarea.buffer.t
1775 set ui_coml .vpane.lower.commarea.buffer.l
1776 label
$ui_coml -text {Commit Message
:} \
1780 trace add variable commit_type
write {uplevel
#0 {
1781 switch
-glob $commit_type \
1782 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
1783 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
1784 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
1785 * {$ui_coml conf
-text {Commit Message
:}}
1787 text
$ui_comm -background white
-borderwidth 1 \
1790 -autoseparators true \
1792 -width 75 -height 9 -wrap none \
1794 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set} \
1796 scrollbar .vpane.lower.commarea.buffer.sby \
1797 -command [list
$ui_comm yview
]
1798 pack
$ui_coml -side top
-fill x
1799 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1800 pack
$ui_comm -side left
-fill y
1801 pack .vpane.lower.commarea.buffer
-side left
-fill y
1803 # -- Commit Message Buffer Context Menu
1805 menu
$ui_comm.ctxm
-tearoff 0
1806 $ui_comm.ctxm add
command -label "Cut" \
1808 -command "tk_textCut $ui_comm"
1809 $ui_comm.ctxm add
command -label "Copy" \
1811 -command "tk_textCopy $ui_comm"
1812 $ui_comm.ctxm add
command -label "Paste" \
1814 -command "tk_textPaste $ui_comm"
1815 $ui_comm.ctxm add
command -label "Delete" \
1817 -command "$ui_comm delete sel.first sel.last"
1818 $ui_comm.ctxm add separator
1819 $ui_comm.ctxm add
command -label "Select All" \
1821 -command "$ui_comm tag add sel 0.0 end"
1822 $ui_comm.ctxm add
command -label "Copy All" \
1825 $ui_comm tag add sel 0.0 end
1826 tk_textCopy $ui_comm
1827 $ui_comm tag remove sel 0.0 end
1829 $ui_comm.ctxm add separator
1830 $ui_comm.ctxm add
command -label "Sign Off" \
1833 bind $ui_comm <Any-Button-3
> "tk_popup $ui_comm.ctxm %X %Y"
1836 set ui_fname_value
{}
1837 set ui_fstatus_value
{}
1838 frame .vpane.lower.
diff.header
-background orange
1839 label .vpane.lower.
diff.header.l1
-text {File
:} \
1840 -background orange \
1842 label .vpane.lower.
diff.header.l2
-textvariable ui_fname_value \
1843 -background orange \
1847 label .vpane.lower.
diff.header.l3
-text {Status
:} \
1848 -background orange \
1850 label .vpane.lower.
diff.header.l4
-textvariable ui_fstatus_value \
1851 -background orange \
1852 -width $max_status_desc \
1856 pack .vpane.lower.
diff.header.l1
-side left
1857 pack .vpane.lower.
diff.header.l2
-side left
-fill x
1858 pack .vpane.lower.
diff.header.l4
-side right
1859 pack .vpane.lower.
diff.header.l3
-side right
1862 frame .vpane.lower.
diff.body
1863 set ui_diff .vpane.lower.
diff.body.t
1864 text
$ui_diff -background white
-borderwidth 0 \
1865 -width 80 -height 15 -wrap none \
1867 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
1868 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
1869 -cursor $maincursor \
1871 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
1872 -command [list
$ui_diff xview
]
1873 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
1874 -command [list
$ui_diff yview
]
1875 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
1876 pack .vpane.lower.
diff.body.sby
-side right
-fill y
1877 pack
$ui_diff -side left
-fill both
-expand 1
1878 pack .vpane.lower.
diff.header
-side top
-fill x
1879 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
1881 $ui_diff tag conf dm
-foreground red
1882 $ui_diff tag conf dp
-foreground blue
1883 $ui_diff tag conf da
-font [concat
$font_diff bold
]
1884 $ui_diff tag conf di
-foreground "#00a000"
1885 $ui_diff tag conf dni
-foreground "#a000a0"
1886 $ui_diff tag conf bold
-font [concat
$font_diff bold
]
1888 # -- Diff Body Context Menu
1890 menu
$ui_diff.ctxm
-tearoff 0
1891 $ui_diff.ctxm add
command -label "Copy" \
1893 -command "tk_textCopy $ui_diff"
1894 $ui_diff.ctxm add
command -label "Select All" \
1896 -command "$ui_diff tag add sel 0.0 end"
1897 $ui_diff.ctxm add
command -label "Copy All" \
1900 $ui_diff tag add sel 0.0 end
1901 tk_textCopy $ui_diff
1902 $ui_diff tag remove sel 0.0 end
1904 bind $ui_diff <Any-Button-3
> "tk_popup $ui_diff.ctxm %X %Y"
1907 set ui_status_value
{Initializing...
}
1908 label .status
-textvariable ui_status_value \
1914 pack .status
-anchor w
-side bottom
-fill x
1918 set gm
[lindex
$repo_config(gui.geometry
) 0]
1919 wm geometry .
[lindex
$gm 0]
1920 .vpane sash place
0 \
1921 [lindex
[.vpane sash coord
0] 0] \
1923 .vpane.files sash place
0 \
1925 [lindex
[.vpane.files sash coord
0] 1]
1930 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
1931 bind $ui_comm <$M1B-Key-i> {do_include_all
;break}
1932 bind $ui_comm <$M1B-Key-I> {do_include_all
;break}
1933 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
1934 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
1935 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
1936 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
1937 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
1938 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
1939 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
1940 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
1942 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
1943 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
1944 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
1945 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
1946 bind $ui_diff <$M1B-Key-v> {break}
1947 bind $ui_diff <$M1B-Key-V> {break}
1948 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
1949 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
1950 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
1951 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
1952 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
1953 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
1955 bind .
<Destroy
> do_quit
1956 bind all
<Key-F5
> do_rescan
1957 bind all
<$M1B-Key-r> do_rescan
1958 bind all
<$M1B-Key-R> do_rescan
1959 bind .
<$M1B-Key-s> do_signoff
1960 bind .
<$M1B-Key-S> do_signoff
1961 bind .
<$M1B-Key-i> do_include_all
1962 bind .
<$M1B-Key-I> do_include_all
1963 bind .
<$M1B-Key-Return> do_commit
1964 bind all
<$M1B-Key-q> do_quit
1965 bind all
<$M1B-Key-Q> do_quit
1966 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
1967 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
1968 foreach i
[list
$ui_index $ui_other] {
1969 bind $i <Button-1
> {click
%W
%x
%y
1 %X
%Y
; break}
1970 bind $i <Button-3
> {click
%W
%x
%y
3 %X
%Y
; break}
1971 bind $i <ButtonRelease-1
> {unclick
%W
%x
%y
; break}
1975 set file_lists
($ui_index) [list
]
1976 set file_lists
($ui_other) [list
]
1978 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
1979 focus
-force $ui_comm
1981 populate_remote_menu .mbar.fetch From fetch_from
1982 populate_remote_menu .mbar.push To push_to
1983 populate_pull_menu .mbar.pull