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
44 if {[catch
{set rc_trustMTime
$repo_config(gui.trustmtime
)}]} {
45 set rc_trustMTime
[list false
]
47 if {$cfg_trust_mtime != [lindex
$rc_trustMTime 0]} {
48 exec git repo-config gui.trustMTime
$cfg_trust_mtime
49 set repo_config
(gui.trustmtime
) [list
$cfg_trust_mtime]
52 if {[catch
{set rc_fontdiff
$repo_config(gui.fontdiff
)}]} {
53 set rc_fontdiff
[list
{Courier
10}]
55 if {$font_diff != [lindex
$rc_fontdiff 0]} {
56 exec git repo-config
--global gui.fontDiff
$font_diff
57 set repo_config
(gui.fontdiff
) [list
$font_diff]
60 set cfg_geometry
[wm geometry .
]
61 append cfg_geometry
" [lindex [.vpane sash coord 0] 1]"
62 append cfg_geometry
" [lindex [.vpane.files sash coord 0] 0]"
63 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
64 set rc_geometry
[list
[list
]]
66 if {$cfg_geometry != [lindex
$rc_geometry 0]} {
67 exec git repo-config gui.geometry
$cfg_geometry
68 set repo_config
(gui.geometry
) [list
$cfg_geometry]
72 proc error_popup
{msg
} {
78 append title
[lindex \
79 [file split [file normalize
[file dirname $gitdir]]] \
87 -title "$title: error" \
91 proc info_popup
{msg
} {
97 append title
[lindex \
98 [file split [file normalize
[file dirname $gitdir]]] \
110 ######################################################################
114 if { [catch
{set cdup
[exec git rev-parse
--show-cdup]} err
]
115 ||
[catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
116 catch
{wm withdraw .
}
117 error_popup
"Cannot find the git directory:\n\n$err"
125 if {$appname == {git-citool
}} {
131 ######################################################################
140 set update_index_fd
{}
142 set disable_on_lock
[list
]
143 set index_lock_type none
149 proc lock_index
{type} {
150 global index_lock_type disable_on_lock
152 if {$index_lock_type == {none
}} {
153 set index_lock_type
$type
154 foreach w
$disable_on_lock {
155 uplevel
#0 $w disabled
158 } elseif
{$index_lock_type == {begin-update
} && $type == {update
}} {
159 set index_lock_type
$type
165 proc unlock_index
{} {
166 global index_lock_type disable_on_lock
168 set index_lock_type none
169 foreach w
$disable_on_lock {
174 ######################################################################
178 proc repository_state
{hdvar ctvar
} {
180 upvar
$hdvar hd
$ctvar ct
182 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
184 } elseif
{[file exists
[file join $gitdir MERGE_HEAD
]]} {
191 proc update_status
{{final Ready.
}} {
192 global HEAD PARENT commit_type
193 global ui_index ui_other ui_status_value ui_comm
194 global status_active file_states
195 global cfg_trust_mtime
197 if {$status_active ||
![lock_index
read]} return
199 repository_state new_HEAD new_type
200 if {$commit_type == {amend
}
201 && $new_type == {normal
}
202 && $new_HEAD == $HEAD} {
206 set commit_type
$new_type
209 array
unset file_states
211 if {![$ui_comm edit modified
]
212 ||
[string trim
[$ui_comm get
0.0 end
]] == {}} {
213 if {[load_message GITGUI_MSG
]} {
214 } elseif
{[load_message MERGE_MSG
]} {
215 } elseif
{[load_message SQUASH_MSG
]} {
217 $ui_comm edit modified false
221 if {$cfg_trust_mtime == {true
}} {
222 update_status_stage2
{} $final
225 set ui_status_value
{Refreshing
file status...
}
226 set cmd
[list git update-index
]
228 lappend cmd
--unmerged
229 lappend cmd
--ignore-missing
230 lappend cmd
--refresh
231 set fd_rf
[open
"| $cmd" r
]
232 fconfigure
$fd_rf -blocking 0 -translation binary
233 fileevent
$fd_rf readable \
234 [list update_status_stage2
$fd_rf $final]
238 proc update_status_stage2
{fd final
} {
239 global gitdir PARENT commit_type
240 global ui_index ui_other ui_status_value ui_comm
242 global buf_rdi buf_rdf buf_rlo
246 if {![eof
$fd]} return
250 set ls_others
[list | git ls-files
--others -z \
251 --exclude-per-directory=.gitignore
]
252 set info_exclude
[file join $gitdir info exclude
]
253 if {[file readable
$info_exclude]} {
254 lappend ls_others
"--exclude-from=$info_exclude"
262 set ui_status_value
{Scanning
for modified files ...
}
263 set fd_di
[open
"| git diff-index --cached -z $PARENT" r
]
264 set fd_df
[open
"| git diff-files -z" r
]
265 set fd_lo
[open
$ls_others r
]
267 fconfigure
$fd_di -blocking 0 -translation binary
268 fconfigure
$fd_df -blocking 0 -translation binary
269 fconfigure
$fd_lo -blocking 0 -translation binary
270 fileevent
$fd_di readable
[list read_diff_index
$fd_di $final]
271 fileevent
$fd_df readable
[list read_diff_files
$fd_df $final]
272 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $final]
275 proc load_message
{file} {
276 global gitdir ui_comm
278 set f
[file join $gitdir $file]
279 if {[file isfile
$f]} {
280 if {[catch
{set fd
[open
$f r
]}]} {
283 set content
[string trim
[read $fd]]
285 $ui_comm delete
0.0 end
286 $ui_comm insert end
$content
292 proc read_diff_index
{fd final
} {
295 append buf_rdi
[read $fd]
297 set n
[string length
$buf_rdi]
299 set z1
[string first
"\0" $buf_rdi $c]
302 set z2
[string first
"\0" $buf_rdi $z1]
308 [string range
$buf_rdi $z1 $z2] \
309 [string index
$buf_rdi [expr $z1 - 2]]_
313 set buf_rdi
[string range
$buf_rdi $c end
]
318 status_eof
$fd buf_rdi
$final
321 proc read_diff_files
{fd final
} {
324 append buf_rdf
[read $fd]
326 set n
[string length
$buf_rdf]
328 set z1
[string first
"\0" $buf_rdf $c]
331 set z2
[string first
"\0" $buf_rdf $z1]
337 [string range
$buf_rdf $z1 $z2] \
338 _
[string index
$buf_rdf [expr $z1 - 2]]
342 set buf_rdf
[string range
$buf_rdf $c end
]
347 status_eof
$fd buf_rdf
$final
350 proc read_ls_others
{fd final
} {
353 append buf_rlo
[read $fd]
354 set pck
[split $buf_rlo "\0"]
355 set buf_rlo
[lindex
$pck end
]
356 foreach p
[lrange
$pck 0 end-1
] {
359 status_eof
$fd buf_rlo
$final
362 proc status_eof
{fd buf final
} {
363 global status_active ui_status_value
370 if {[incr status_active
-1] == 0} {
374 set ui_status_value
$final
379 ######################################################################
384 global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
386 $ui_diff conf
-state normal
387 $ui_diff delete
0.0 end
388 $ui_diff conf
-state disabled
390 set ui_fname_value
{}
391 set ui_fstatus_value
{}
393 $ui_index tag remove in_diff
0.0 end
394 $ui_other tag remove in_diff
0.0 end
397 proc reshow_diff
{} {
398 global ui_fname_value ui_status_value file_states
400 if {$ui_fname_value == {}
401 ||
[catch
{set s
$file_states($ui_fname_value)}]} {
404 show_diff
$ui_fname_value
408 proc handle_empty_diff
{} {
409 global ui_fname_value file_states file_lists
411 set path
$ui_fname_value
412 set s
$file_states($path)
413 if {[lindex
$s 0] != {_M
}} return
415 info_popup
"No differences detected.
417 [short_path $path] has no changes.
419 The modification date of this file was updated by another
420 application and you currently have the Trust File Modification
421 Timestamps feature enabled, so Git did not automatically detect
422 that there are no content differences in this file.
424 This file will now be removed from the modified files list, to
425 prevent possible confusion.
427 if {[catch
{exec git update-index
-- $path} err
]} {
428 error_popup
"Failed to refresh index:\n\n$err"
432 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
433 set lno
[lsearch
-sorted $file_lists($old_w) $path]
435 set file_lists
($old_w) \
436 [lreplace
$file_lists($old_w) $lno $lno]
438 $old_w conf
-state normal
439 $old_w delete
$lno.0 [expr $lno + 1].0
440 $old_w conf
-state disabled
444 proc show_diff
{path
{w
{}} {lno
{}}} {
445 global file_states file_lists
446 global PARENT diff_3way diff_active
447 global ui_diff ui_fname_value ui_fstatus_value ui_status_value
449 if {$diff_active ||
![lock_index
read]} return
452 if {$w == {} ||
$lno == {}} {
453 foreach w
[array names file_lists
] {
454 set lno
[lsearch
-sorted $file_lists($w) $path]
461 if {$w != {} && $lno >= 1} {
462 $w tag add in_diff
$lno.0 [expr $lno + 1].0
465 set s
$file_states($path)
469 set ui_fname_value
[escape_path
$path]
470 set ui_fstatus_value
[mapdesc
$m $path]
471 set ui_status_value
"Loading diff of [escape_path $path]..."
473 set cmd
[list | git diff-index
-p $PARENT -- $path]
476 set cmd
[list | git diff-index
-p -c $PARENT $path]
480 set fd
[open
$path r
]
481 set content
[read $fd]
486 set ui_status_value
"Unable to display [escape_path $path]"
487 error_popup
"Error loading file:\n\n$err"
490 $ui_diff conf
-state normal
491 $ui_diff insert end
$content
492 $ui_diff conf
-state disabled
495 set ui_status_value
{Ready.
}
500 if {[catch
{set fd
[open
$cmd r
]} err
]} {
503 set ui_status_value
"Unable to display [escape_path $path]"
504 error_popup
"Error loading diff:\n\n$err"
508 fconfigure
$fd -blocking 0 -translation auto
509 fileevent
$fd readable
[list read_diff
$fd]
512 proc read_diff
{fd
} {
513 global ui_diff ui_status_value diff_3way diff_active
514 global cfg_trust_mtime
516 while {[gets
$fd line
] >= 0} {
517 if {[string match
{diff --git *} $line]} continue
518 if {[string match
{diff --combined *} $line]} continue
519 if {[string match
{--- *} $line]} continue
520 if {[string match
{+++ *} $line]} continue
521 if {[string match index
* $line]} {
522 if {[string first
, $line] >= 0} {
527 $ui_diff conf
-state normal
529 set x
[string index
$line 0]
534 default
{set tags
{}}
537 set x
[string range
$line 0 1]
539 default
{set tags
{}}
541 "++" {set tags dp
; set x
" +"}
542 " +" {set tags
{di bold
}; set x
"++"}
543 "+ " {set tags dni
; set x
"-+"}
544 "--" {set tags dm
; set x
" -"}
545 " -" {set tags
{dm bold
}; set x
"--"}
546 "- " {set tags di
; set x
"+-"}
547 default
{set tags
{}}
549 set line
[string replace
$line 0 1 $x]
551 $ui_diff insert end
$line $tags
552 $ui_diff insert end
"\n"
553 $ui_diff conf
-state disabled
560 set ui_status_value
{Ready.
}
562 if {$cfg_trust_mtime && [$ui_diff index end
] == {2.0}} {
568 ######################################################################
572 proc load_last_commit
{} {
573 global HEAD PARENT commit_type ui_comm
575 if {$commit_type == {amend
}} return
576 if {$commit_type != {normal
}} {
577 error_popup
"Can't amend a $commit_type commit."
585 set fd
[open
"| git cat-file commit $HEAD" r
]
586 while {[gets
$fd line
] > 0} {
587 if {[string match
{parent
*} $line]} {
588 set parent
[string range
$line 7 end
]
592 set msg
[string trim
[read $fd]]
595 error_popup
"Error loading commit data for amend:\n\n$err"
599 if {$parent_count == 0} {
600 set commit_type amend
604 } elseif
{$parent_count == 1} {
605 set commit_type amend
607 $ui_comm delete
0.0 end
608 $ui_comm insert end
$msg
609 $ui_comm edit modified false
613 error_popup
{You can
't amend a merge commit.}
618 proc commit_tree {} {
619 global tcl_platform HEAD gitdir commit_type file_states
620 global commit_active ui_status_value
623 if {$commit_active || ![lock_index update]} return
625 # -- Our in memory state should match the repository.
627 repository_state curHEAD cur_type
628 if {$commit_type == {amend}
629 && $cur_type == {normal}
630 && $curHEAD == $HEAD} {
631 } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
632 error_popup {Last scanned state does not match repository state.
634 Its highly likely that another Git program modified the
635 repository since our last scan. A rescan is required
643 # -- At least one file should differ in the index.
646 foreach path [array names file_states] {
647 set s $file_states($path)
648 switch -glob -- [lindex $s 0] {
652 M? {set files_ready 1; break}
654 error_popup "Unmerged files cannot be committed.
656 File [short_path $path] has merge conflicts.
657 You must resolve them and include the file before committing.
663 error_popup "Unknown file state [lindex $s 0] detected.
665 File [short_path $path] cannot be committed by this program.
671 error_popup {No included files to commit.
673 You must include at least 1 file before you can commit.
679 # -- A message is required.
681 set msg [string trim [$ui_comm get 1.0 end]]
683 error_popup {Please supply a commit message.
685 A good commit message has the following format:
687 - First line: Describe in one sentance what you did.
689 - Remaining lines: Describe why this change is good.
695 # -- Ask the pre-commit hook for the go-ahead.
697 set pchook [file join $gitdir hooks pre-commit]
698 if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
699 set pchook [list sh -c \
700 "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
701 } elseif {[file executable $pchook]} {
702 set pchook [list $pchook]
706 if {$pchook != {} && [catch {eval exec $pchook} err]} {
707 hook_failed_popup pre-commit $err
712 # -- Write the tree in the background.
715 set ui_status_value {Committing changes...}
717 set fd_wt [open "| git write-tree" r]
718 fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
721 proc commit_stage2 {fd_wt curHEAD msg} {
722 global single_commit gitdir HEAD PARENT commit_type
723 global commit_active ui_status_value ui_comm
727 if {$tree_id == {} || [catch {close $fd_wt} err]} {
728 error_popup "write-tree failed:\n\n$err"
730 set ui_status_value {Commit failed.}
735 # -- Create the commit.
737 set cmd [list git commit-tree $tree_id]
739 lappend cmd -p $PARENT
741 if {$commit_type == {merge}} {
743 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
744 while {[gets $fd_mh merge_head] >= 0} {
745 lappend cmd -p $merge_head
749 error_popup "Loading MERGE_HEAD failed:\n\n$err"
751 set ui_status_value {Commit failed.}
757 # git commit-tree writes to stderr during initial commit.
758 lappend cmd 2>/dev/null
761 if {[catch {set cmt_id [eval exec $cmd]} err]} {
762 error_popup "commit-tree failed:\n\n$err"
764 set ui_status_value {Commit failed.}
769 # -- Update the HEAD ref.
772 if {$commit_type != {normal}} {
773 append reflogm " ($commit_type)"
775 set i [string first "\n" $msg]
777 append reflogm {: } [string range $msg 0 [expr $i - 1]]
779 append reflogm {: } $msg
781 set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
782 if {[catch {eval exec $cmd} err]} {
783 error_popup "update-ref failed:\n\n$err"
785 set ui_status_value {Commit failed.}
790 # -- Cleanup after ourselves.
792 catch {file delete [file join $gitdir MERGE_HEAD]}
793 catch {file delete [file join $gitdir MERGE_MSG]}
794 catch {file delete [file join $gitdir SQUASH_MSG]}
795 catch {file delete [file join $gitdir GITGUI_MSG]}
797 # -- Let rerere do its thing.
799 if {[file isdirectory [file join $gitdir rr-cache]]} {
800 catch {exec git rerere}
803 $ui_comm delete 0.0 end
804 $ui_comm edit modified false
807 if {$single_commit} do_quit
809 # -- Update status without invoking any git commands.
812 set commit_type normal
816 foreach path [array names file_states] {
817 set s $file_states($path)
822 D? {set m _[string index $m 1]}
826 unset file_states($path)
828 lset file_states($path) 0 $m
835 set ui_status_value \
836 "Changes committed as [string range $cmt_id 0 7]."
839 ######################################################################
843 proc fetch_from {remote} {
844 set w [new_console "fetch $remote" \
845 "Fetching new changes from $remote"]
846 set cmd [list git fetch]
851 proc pull_remote {remote branch} {
852 global HEAD commit_type
855 if {![lock_index update]} return
857 # -- Our in memory state should match the repository.
859 repository_state curHEAD cur_type
860 if {$commit_type != $cur_type || $HEAD != $curHEAD} {
861 error_popup {Last scanned state does not match repository state.
863 Its highly likely that another Git program modified the
864 repository since our last scan. A rescan is required
865 before a pull can be started.
872 # -- No differences should exist before a pull.
874 if {[array size file_states] != 0} {
875 error_popup {Uncommitted but modified files are present.
877 You should not perform a pull with unmodified files in your working
878 directory as Git would be unable to recover from an incorrect merge.
880 Commit or throw away all changes before starting a pull operation.
886 set w [new_console "pull $remote $branch" \
887 "Pulling new changes from branch $branch in $remote"]
888 set cmd [list git pull]
891 console_exec $w $cmd [list post_pull_remote $remote $branch]
894 proc post_pull_remote {remote branch success} {
895 global HEAD PARENT commit_type
896 global ui_status_value
900 repository_state HEAD commit_type
902 set $ui_status_value {Ready.}
905 "Conflicts detected while pulling $branch from $remote."
909 proc push_to {remote} {
910 set w [new_console "push $remote" \
911 "Pushing changes to $remote"]
912 set cmd [list git push]
917 ######################################################################
921 proc mapcol {state path} {
922 global all_cols ui_other
924 if {[catch {set r $all_cols($state)}]} {
925 puts "error: no column for state={$state} $path"
931 proc mapicon {state path} {
934 if {[catch {set r $all_icons($state)}]} {
935 puts "error: no icon for state={$state} $path"
941 proc mapdesc {state path} {
944 if {[catch {set r $all_descs($state)}]} {
945 puts "error: no desc for state={$state} $path"
951 proc escape_path {path} {
952 regsub -all "\n" $path "\\n" path
956 proc short_path {path} {
957 return [escape_path [lindex [file split $path] end]]
962 proc merge_state {path new_state} {
963 global file_states next_icon_id
965 set s0 [string index $new_state 0]
966 set s1 [string index $new_state 1]
968 if {[catch {set info $file_states($path)}]} {
970 set icon n[incr next_icon_id]
972 set state [lindex $info 0]
973 set icon [lindex $info 1]
977 set s0 [string index $state 0]
978 } elseif {$s0 == {*}} {
983 set s1 [string index $state 1]
984 } elseif {$s1 == {*}} {
988 set file_states($path) [list $s0$s1 $icon]
992 proc display_file {path state} {
993 global file_states file_lists status_active
995 set old_m [merge_state $path $state]
996 if {$status_active} return
998 set s $file_states($path)
999 set new_m [lindex $s 0]
1000 set new_w [mapcol $new_m $path]
1001 set old_w [mapcol $old_m $path]
1002 set new_icon [mapicon $new_m $path]
1004 if {$new_w != $old_w} {
1005 set lno [lsearch -sorted $file_lists($old_w) $path]
1008 $old_w conf -state normal
1009 $old_w delete $lno.0 [expr $lno + 1].0
1010 $old_w conf -state disabled
1013 lappend file_lists($new_w) $path
1014 set file_lists($new_w) [lsort $file_lists($new_w)]
1015 set lno [lsearch -sorted $file_lists($new_w) $path]
1017 $new_w conf -state normal
1018 $new_w image create $lno.0 \
1019 -align center -padx 5 -pady 1 \
1020 -name [lindex $s 1] \
1022 $new_w insert $lno.1 "[escape_path $path]\n"
1023 $new_w conf -state disabled
1024 } elseif {$new_icon != [mapicon $old_m $path]} {
1025 $new_w conf -state normal
1026 $new_w image conf [lindex $s 1] -image $new_icon
1027 $new_w conf -state disabled
1031 proc display_all_files {} {
1032 global ui_index ui_other file_states file_lists
1034 $ui_index conf -state normal
1035 $ui_other conf -state normal
1037 $ui_index delete 0.0 end
1038 $ui_other delete 0.0 end
1040 set file_lists($ui_index) [list]
1041 set file_lists($ui_other) [list]
1043 foreach path [lsort [array names file_states]] {
1044 set s $file_states($path)
1046 set w [mapcol $m $path]
1047 lappend file_lists($w) $path
1048 $w image create end \
1049 -align center -padx 5 -pady 1 \
1050 -name [lindex $s 1] \
1051 -image [mapicon $m $path]
1052 $w insert end "[escape_path $path]\n"
1055 $ui_index conf -state disabled
1056 $ui_other conf -state disabled
1059 proc with_update_index {body} {
1060 global update_index_fd
1062 if {$update_index_fd == {}} {
1063 if {![lock_index update]} return
1064 set update_index_fd [open \
1065 "| git update-index --add --remove -z --stdin" \
1067 fconfigure $update_index_fd -translation binary
1069 close $update_index_fd
1070 set update_index_fd {}
1077 proc update_index {path} {
1078 global update_index_fd
1080 if {$update_index_fd == {}} {
1081 error {not in with_update_index}
1083 puts -nonewline $update_index_fd "$path\0"
1087 proc toggle_mode {path} {
1088 global file_states ui_fname_value
1090 set s $file_states($path)
1103 with_update_index {update_index $path}
1104 display_file $path $new
1105 if {$ui_fname_value == $path} {
1110 ######################################################################
1112 ## remote management
1114 proc load_all_remotes {} {
1115 global gitdir all_remotes repo_config
1117 set all_remotes [list]
1118 set rm_dir [file join $gitdir remotes]
1119 if {[file isdirectory $rm_dir]} {
1120 set all_remotes [concat $all_remotes [glob \
1124 -directory $rm_dir *]]
1127 foreach line [array names repo_config remote.*.url] {
1128 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1129 lappend all_remotes $name
1133 set all_remotes [lsort -unique $all_remotes]
1136 proc populate_remote_menu {m pfx op} {
1137 global all_remotes font_ui
1139 foreach remote $all_remotes {
1140 $m add command -label "$pfx $remote..." \
1141 -command [list $op $remote] \
1146 proc populate_pull_menu {m} {
1147 global gitdir repo_config all_remotes font_ui disable_on_lock
1149 foreach remote $all_remotes {
1151 if {[array get repo_config remote.$remote.url] != {}} {
1152 if {[array get repo_config remote.$remote.fetch] != {}} {
1153 regexp {^([^:]+):} \
1154 [lindex $repo_config(remote.$remote.fetch) 0] \
1159 set fd [open [file join $gitdir remotes $remote] r]
1160 while {[gets $fd line] >= 0} {
1161 if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1170 regsub ^refs/heads/ $rb {} rb_short
1171 if {$rb_short != {}} {
1173 -label "Branch $rb_short from $remote..." \
1174 -command [list pull_remote $remote $rb] \
1176 lappend disable_on_lock \
1177 [list $m entryconf [$m index last] -state]
1182 ######################################################################
1187 #define mask_width 14
1188 #define mask_height 15
1189 static unsigned char mask_bits[] = {
1190 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1191 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1192 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1195 image create bitmap file_plain -background white -foreground black -data {
1196 #define plain_width 14
1197 #define plain_height 15
1198 static unsigned char plain_bits[] = {
1199 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1200 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1201 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1202 } -maskdata $filemask
1204 image create bitmap file_mod -background white -foreground blue -data {
1205 #define mod_width 14
1206 #define mod_height 15
1207 static unsigned char mod_bits[] = {
1208 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1209 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1210 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1211 } -maskdata $filemask
1213 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1214 #define file_fulltick_width 14
1215 #define file_fulltick_height 15
1216 static unsigned char file_fulltick_bits[] = {
1217 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1218 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1219 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1220 } -maskdata $filemask
1222 image create bitmap file_parttick -background white -foreground "#005050" -data {
1223 #define parttick_width 14
1224 #define parttick_height 15
1225 static unsigned char parttick_bits[] = {
1226 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1227 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1228 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1229 } -maskdata $filemask
1231 image create bitmap file_question -background white -foreground black -data {
1232 #define file_question_width 14
1233 #define file_question_height 15
1234 static unsigned char file_question_bits[] = {
1235 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1236 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1237 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1238 } -maskdata $filemask
1240 image create bitmap file_removed -background white -foreground red -data {
1241 #define file_removed_width 14
1242 #define file_removed_height 15
1243 static unsigned char file_removed_bits[] = {
1244 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1245 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1246 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1247 } -maskdata $filemask
1249 image create bitmap file_merge -background white -foreground blue -data {
1250 #define file_merge_width 14
1251 #define file_merge_height 15
1252 static unsigned char file_merge_bits[] = {
1253 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1254 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1255 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1256 } -maskdata $filemask
1258 set ui_index .vpane.files.index.list
1259 set ui_other .vpane.files.other.list
1260 set max_status_desc 0
1262 {__ i plain "Unmodified"}
1263 {_M i mod "Modified"}
1264 {M_ i fulltick "Checked in"}
1265 {MM i parttick "Partially included"}
1267 {_O o plain "Untracked"}
1268 {A_ o fulltick "Added"}
1269 {AM o parttick "Partially added"}
1270 {AD o question "Added (but now gone)"}
1272 {_D i question "Missing"}
1273 {D_ i removed "Removed"}
1274 {DD i removed "Removed"}
1275 {DO i removed "Removed (still exists)"}
1277 {UM i merge "Merge conflicts"}
1278 {U_ i merge "Merge conflicts"}
1280 if {$max_status_desc < [string length [lindex $i 3]]} {
1281 set max_status_desc [string length [lindex $i 3]]
1283 if {[lindex $i 1] == {i}} {
1284 set all_cols([lindex $i 0]) $ui_index
1286 set all_cols([lindex $i 0]) $ui_other
1288 set all_icons([lindex $i 0]) file_[lindex $i 2]
1289 set all_descs([lindex $i 0]) [lindex $i 3]
1293 ######################################################################
1297 proc hook_failed_popup {hook msg} {
1298 global gitdir font_ui font_diff appname
1305 label $w.m.l1 -text "$hook hook failed:" \
1308 -font [concat $font_ui bold]
1310 -background white -borderwidth 1 \
1312 -width 80 -height 10 \
1314 -yscrollcommand [list $w.m.sby set]
1316 -text {You must correct the above errors before committing.} \
1319 -font [concat $font_ui bold]
1320 scrollbar $w.m.sby -command [list $w.m.t yview]
1321 pack $w.m.l1 -side top -fill x
1322 pack $w.m.l2 -side bottom -fill x
1323 pack $w.m.sby -side right -fill y
1324 pack $w.m.t -side left -fill both -expand 1
1325 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1327 $w.m.t insert 1.0 $msg
1328 $w.m.t conf -state disabled
1330 button $w.ok -text OK \
1333 -command "destroy $w"
1334 pack $w.ok -side bottom
1336 bind $w <Visibility> "grab $w; focus $w"
1337 bind $w <Key-Return> "destroy $w"
1338 wm title $w "$appname ([lindex [file split \
1339 [file normalize [file dirname $gitdir]]] \
1344 set next_console_id 0
1346 proc new_console {short_title long_title} {
1347 global next_console_id console_data
1348 set w .console[incr next_console_id]
1349 set console_data($w) [list $short_title $long_title]
1350 return [console_init $w]
1353 proc console_init {w} {
1354 global console_cr console_data
1355 global gitdir appname font_ui font_diff M1B
1357 set console_cr($w) 1.0
1360 label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1363 -font [concat $font_ui bold]
1365 -background white -borderwidth 1 \
1367 -width 80 -height 10 \
1370 -yscrollcommand [list $w.m.sby set]
1371 label $w.m.s -anchor w \
1373 -font [concat $font_ui bold]
1374 scrollbar $w.m.sby -command [list $w.m.t yview]
1375 pack $w.m.l1 -side top -fill x
1376 pack $w.m.s -side bottom -fill x
1377 pack $w.m.sby -side right -fill y
1378 pack $w.m.t -side left -fill both -expand 1
1379 pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1381 menu $w.ctxm -tearoff 0
1382 $w.ctxm add command -label "Copy" \
1384 -command "tk_textCopy $w.m.t"
1385 $w.ctxm add command -label "Select All" \
1387 -command "$w.m.t tag add sel 0.0 end"
1388 $w.ctxm add command -label "Copy All" \
1391 $w.m.t tag add sel 0.0 end
1393 $w.m.t tag remove sel 0.0 end
1396 button $w.ok -text {Running...} \
1400 -command "destroy $w"
1401 pack $w.ok -side bottom
1403 bind $w.m.t <Any-Button-3> "tk_popup $w.ctxm %X %Y"
1404 bind $w.m.t <$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1405 bind $w.m.t <$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1406 bind $w <Visibility> "focus $w"
1407 wm title $w "$appname ([lindex [file split \
1408 [file normalize [file dirname $gitdir]]] \
1409 end]): [lindex $console_data($w) 0]"
1413 proc console_exec {w cmd {after {}}} {
1416 # -- Windows tosses the enviroment when we exec our child.
1417 # But most users need that so we have to relogin. :-(
1419 if {$tcl_platform(platform) == {windows}} {
1420 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1423 # -- Tcl won't
let us redirect both stdout and stderr to
1424 # the same pipe. So pass it through cat...
1426 set cmd
[concat |
$cmd |
& cat]
1428 set fd_f
[open
$cmd r
]
1429 fconfigure
$fd_f -blocking 0 -translation binary
1430 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1433 proc console_read
{w fd after
} {
1434 global console_cr console_data
1438 if {![winfo exists
$w]} {console_init
$w}
1439 $w.m.t conf
-state normal
1441 set n
[string length
$buf]
1443 set cr
[string first
"\r" $buf $c]
1444 set lf
[string first
"\n" $buf $c]
1445 if {$cr < 0} {set cr
[expr $n + 1]}
1446 if {$lf < 0} {set lf
[expr $n + 1]}
1449 $w.m.t insert end
[string range
$buf $c $lf]
1450 set console_cr
($w) [$w.m.t index
{end
-1c}]
1454 $w.m.t delete
$console_cr($w) end
1455 $w.m.t insert end
"\n"
1456 $w.m.t insert end
[string range
$buf $c $cr]
1461 $w.m.t conf
-state disabled
1465 fconfigure
$fd -blocking 1
1467 if {[catch
{close
$fd}]} {
1468 if {![winfo exists
$w]} {console_init
$w}
1469 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1470 $w.ok conf
-text Close
1471 $w.ok conf
-state normal
1473 } elseif
{[winfo exists
$w]} {
1474 $w.m.s conf
-background green
-text {Success
}
1475 $w.ok conf
-text Close
1476 $w.ok conf
-state normal
1479 array
unset console_cr
$w
1480 array
unset console_data
$w
1482 uplevel
#0 $after $ok
1486 fconfigure
$fd -blocking 0
1489 ######################################################################
1493 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1496 global tcl_platform ui_status_value starting_gitk_msg
1498 set ui_status_value
$starting_gitk_msg
1500 if {$ui_status_value == $starting_gitk_msg} {
1501 set ui_status_value
{Ready.
}
1505 if {$tcl_platform(platform
) == {windows
}} {
1513 set w
[new_console
"repack" "Repacking the object database"]
1514 set cmd
[list git repack
]
1517 console_exec
$w $cmd
1523 global gitdir ui_comm quitting
1525 if {$quitting} return
1528 set save
[file join $gitdir GITGUI_MSG
]
1529 set msg
[string trim
[$ui_comm get
0.0 end
]]
1530 if {[$ui_comm edit modified
] && $msg != {}} {
1532 set fd
[open
$save w
]
1533 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1536 } elseif
{$msg == {} && [file exists
$save]} {
1548 proc do_include_all
{} {
1549 global update_active ui_status_value
1551 if {$update_active ||
![lock_index begin-update
]} return
1554 set ui_status_value
{Including all modified files...
}
1557 foreach path
[array names file_states
] {
1558 set s
$file_states($path)
1564 _D
{toggle_mode
$path}
1569 set ui_status_value
{Ready.
}
1573 set GIT_COMMITTER_IDENT
{}
1575 proc do_signoff
{} {
1576 global ui_comm GIT_COMMITTER_IDENT
1578 if {$GIT_COMMITTER_IDENT == {}} {
1579 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1580 error_popup
"Unable to obtain your identity:\n\n$err"
1583 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1584 $me me GIT_COMMITTER_IDENT
]} {
1585 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1590 set sob
"Signed-off-by: $GIT_COMMITTER_IDENT"
1591 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
1592 if {$last != $sob} {
1593 $ui_comm edit separator
1595 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
1596 $ui_comm insert end
"\n"
1598 $ui_comm insert end
"\n$sob"
1599 $ui_comm edit separator
1604 proc do_amend_last
{} {
1612 # shift == 1: left click
1614 proc click
{w x y
shift wx wy
} {
1615 global ui_index ui_other file_lists
1617 set pos
[split [$w index @
$x,$y] .
]
1618 set lno
[lindex
$pos 0]
1619 set col [lindex
$pos 1]
1620 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1621 if {$path == {}} return
1623 if {$col > 0 && $shift == 1} {
1624 show_diff
$path $w $lno
1628 proc unclick
{w x y
} {
1631 set pos
[split [$w index @
$x,$y] .
]
1632 set lno
[lindex
$pos 0]
1633 set col [lindex
$pos 1]
1634 set path
[lindex
$file_lists($w) [expr $lno - 1]]
1635 if {$path == {}} return
1642 ######################################################################
1649 menu .mbar
-tearoff 0
1650 catch
{set font_ui
[lindex
$repo_config(gui.fontui
) 0]}
1651 catch
{set font_diff
[lindex
$repo_config(gui.fontdiff
) 0]}
1652 if {$font_ui == {}} {catch
{set font_ui
[.mbar cget
-font]}}
1653 if {$font_ui == {}} {set font_ui
{Helvetica
10}}
1654 if {$font_diff == {}} {set font_diff
{Courier
10}}
1655 if {$cursor_ptr == {}} {set cursor_ptr left_ptr
}
1657 switch
-glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1658 windows
,* {set M1B Control
; set M1T Ctrl
}
1659 unix
,Darwin
{set M1B M1
; set M1T Cmd
}
1660 * {set M1B M1
; set M1T M1
}
1664 .mbar add cascade
-label Project
-menu .mbar.project
1665 .mbar add cascade
-label Edit
-menu .mbar.edit
1666 .mbar add cascade
-label Commit
-menu .mbar.commit
1667 .mbar add cascade
-label Fetch
-menu .mbar.fetch
1668 .mbar add cascade
-label Pull
-menu .mbar.pull
1669 .mbar add cascade
-label Push
-menu .mbar.push
1670 .mbar add cascade
-label Options
-menu .mbar.options
1671 . configure
-menu .mbar
1675 .mbar.project add
command -label Visualize \
1678 .mbar.project add
command -label {Repack Database
} \
1679 -command do_repack \
1681 .mbar.project add
command -label Quit \
1683 -accelerator $M1T-Q \
1689 .mbar.edit add
command -label Undo \
1690 -command {catch
{[focus
] edit undo
}} \
1691 -accelerator $M1T-Z \
1693 .mbar.edit add
command -label Redo \
1694 -command {catch
{[focus
] edit redo
}} \
1695 -accelerator $M1T-Y \
1697 .mbar.edit add separator
1698 .mbar.edit add
command -label Cut \
1699 -command {catch
{tk_textCut
[focus
]}} \
1700 -accelerator $M1T-X \
1702 .mbar.edit add
command -label Copy \
1703 -command {catch
{tk_textCopy
[focus
]}} \
1704 -accelerator $M1T-C \
1706 .mbar.edit add
command -label Paste \
1707 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
1708 -accelerator $M1T-V \
1710 .mbar.edit add
command -label Delete \
1711 -command {catch
{[focus
] delete sel.first sel.last
}} \
1714 .mbar.edit add separator
1715 .mbar.edit add
command -label {Select All
} \
1716 -command {catch
{[focus
] tag add sel
0.0 end
}} \
1717 -accelerator $M1T-A \
1722 .mbar.commit add
command -label Rescan \
1723 -command do_rescan \
1726 lappend disable_on_lock \
1727 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1728 .mbar.commit add
command -label {Amend Last Commit
} \
1729 -command do_amend_last \
1731 lappend disable_on_lock \
1732 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1733 .mbar.commit add
command -label {Include All Files
} \
1734 -command do_include_all \
1735 -accelerator $M1T-I \
1737 lappend disable_on_lock \
1738 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1739 .mbar.commit add
command -label {Sign Off
} \
1740 -command do_signoff \
1741 -accelerator $M1T-S \
1743 .mbar.commit add
command -label Commit \
1744 -command do_commit \
1745 -accelerator $M1T-Return \
1747 lappend disable_on_lock \
1748 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
1761 .mbar.options add checkbutton \
1762 -label {Trust File Modification Timestamps
} \
1766 -variable cfg_trust_mtime
1768 # -- Main Window Layout
1769 panedwindow .vpane
-orient vertical
1770 panedwindow .vpane.files
-orient horizontal
1771 .vpane add .vpane.files
-sticky nsew
-height 100 -width 400
1772 pack .vpane
-anchor n
-side top
-fill both
-expand 1
1774 # -- Index File List
1775 frame .vpane.files.index
-height 100 -width 400
1776 label .vpane.files.index.title
-text {Modified Files
} \
1779 text
$ui_index -background white
-borderwidth 0 \
1780 -width 40 -height 10 \
1782 -cursor $cursor_ptr \
1783 -yscrollcommand {.vpane.files.index.sb
set} \
1785 scrollbar .vpane.files.index.sb
-command [list
$ui_index yview
]
1786 pack .vpane.files.index.title
-side top
-fill x
1787 pack .vpane.files.index.sb
-side right
-fill y
1788 pack
$ui_index -side left
-fill both
-expand 1
1789 .vpane.files add .vpane.files.index
-sticky nsew
1791 # -- Other (Add) File List
1792 frame .vpane.files.other
-height 100 -width 100
1793 label .vpane.files.other.title
-text {Untracked Files
} \
1796 text
$ui_other -background white
-borderwidth 0 \
1797 -width 40 -height 10 \
1799 -cursor $cursor_ptr \
1800 -yscrollcommand {.vpane.files.other.sb
set} \
1802 scrollbar .vpane.files.other.sb
-command [list
$ui_other yview
]
1803 pack .vpane.files.other.title
-side top
-fill x
1804 pack .vpane.files.other.sb
-side right
-fill y
1805 pack
$ui_other -side left
-fill both
-expand 1
1806 .vpane.files add .vpane.files.other
-sticky nsew
1808 $ui_index tag conf in_diff
-font [concat
$font_ui bold
]
1809 $ui_other tag conf in_diff
-font [concat
$font_ui bold
]
1811 # -- Diff and Commit Area
1812 frame .vpane.lower
-height 400 -width 400
1813 frame .vpane.lower.commarea
1814 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
1815 pack .vpane.lower.commarea
-side top
-fill x
1816 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
1817 .vpane add .vpane.lower
-stick nsew
1819 # -- Commit Area Buttons
1820 frame .vpane.lower.commarea.buttons
1821 label .vpane.lower.commarea.buttons.l
-text {} \
1825 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
1826 pack .vpane.lower.commarea.buttons
-side left
-fill y
1828 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
1829 -command do_rescan \
1831 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
1832 lappend disable_on_lock \
1833 {.vpane.lower.commarea.buttons.rescan conf
-state}
1835 button .vpane.lower.commarea.buttons.amend
-text {Amend Last
} \
1836 -command do_amend_last \
1838 pack .vpane.lower.commarea.buttons.amend
-side top
-fill x
1839 lappend disable_on_lock \
1840 {.vpane.lower.commarea.buttons.amend conf
-state}
1842 button .vpane.lower.commarea.buttons.incall
-text {Include All
} \
1843 -command do_include_all \
1845 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
1846 lappend disable_on_lock \
1847 {.vpane.lower.commarea.buttons.incall conf
-state}
1849 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
1850 -command do_signoff \
1852 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
1854 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
1855 -command do_commit \
1857 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
1858 lappend disable_on_lock \
1859 {.vpane.lower.commarea.buttons.commit conf
-state}
1861 # -- Commit Message Buffer
1862 frame .vpane.lower.commarea.buffer
1863 set ui_comm .vpane.lower.commarea.buffer.t
1864 set ui_coml .vpane.lower.commarea.buffer.l
1865 label
$ui_coml -text {Commit Message
:} \
1869 trace add variable commit_type
write {uplevel
#0 {
1870 switch
-glob $commit_type \
1871 initial
{$ui_coml conf
-text {Initial Commit Message
:}} \
1872 amend
{$ui_coml conf
-text {Amended Commit Message
:}} \
1873 merge
{$ui_coml conf
-text {Merge Commit Message
:}} \
1874 * {$ui_coml conf
-text {Commit Message
:}}
1876 text
$ui_comm -background white
-borderwidth 1 \
1879 -autoseparators true \
1881 -width 75 -height 9 -wrap none \
1883 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
1884 scrollbar .vpane.lower.commarea.buffer.sby \
1885 -command [list
$ui_comm yview
]
1886 pack
$ui_coml -side top
-fill x
1887 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
1888 pack
$ui_comm -side left
-fill y
1889 pack .vpane.lower.commarea.buffer
-side left
-fill y
1891 # -- Commit Message Buffer Context Menu
1893 menu
$ui_comm.ctxm
-tearoff 0
1894 $ui_comm.ctxm add
command -label "Cut" \
1896 -command "tk_textCut $ui_comm"
1897 $ui_comm.ctxm add
command -label "Copy" \
1899 -command "tk_textCopy $ui_comm"
1900 $ui_comm.ctxm add
command -label "Paste" \
1902 -command "tk_textPaste $ui_comm"
1903 $ui_comm.ctxm add
command -label "Delete" \
1905 -command "$ui_comm delete sel.first sel.last"
1906 $ui_comm.ctxm add separator
1907 $ui_comm.ctxm add
command -label "Select All" \
1909 -command "$ui_comm tag add sel 0.0 end"
1910 $ui_comm.ctxm add
command -label "Copy All" \
1913 $ui_comm tag add sel 0.0 end
1914 tk_textCopy $ui_comm
1915 $ui_comm tag remove sel 0.0 end
1917 $ui_comm.ctxm add separator
1918 $ui_comm.ctxm add
command -label "Sign Off" \
1921 bind $ui_comm <Any-Button-3
> "tk_popup $ui_comm.ctxm %X %Y"
1924 set ui_fname_value
{}
1925 set ui_fstatus_value
{}
1926 frame .vpane.lower.
diff.header
-background orange
1927 label .vpane.lower.
diff.header.l1
-text {File
:} \
1928 -background orange \
1930 label .vpane.lower.
diff.header.l2
-textvariable ui_fname_value \
1931 -background orange \
1935 label .vpane.lower.
diff.header.l3
-text {Status
:} \
1936 -background orange \
1938 label .vpane.lower.
diff.header.l4
-textvariable ui_fstatus_value \
1939 -background orange \
1940 -width $max_status_desc \
1944 pack .vpane.lower.
diff.header.l1
-side left
1945 pack .vpane.lower.
diff.header.l2
-side left
-fill x
1946 pack .vpane.lower.
diff.header.l4
-side right
1947 pack .vpane.lower.
diff.header.l3
-side right
1950 frame .vpane.lower.
diff.body
1951 set ui_diff .vpane.lower.
diff.body.t
1952 text
$ui_diff -background white
-borderwidth 0 \
1953 -width 80 -height 15 -wrap none \
1955 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
1956 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
1958 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
1959 -command [list
$ui_diff xview
]
1960 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
1961 -command [list
$ui_diff yview
]
1962 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
1963 pack .vpane.lower.
diff.body.sby
-side right
-fill y
1964 pack
$ui_diff -side left
-fill both
-expand 1
1965 pack .vpane.lower.
diff.header
-side top
-fill x
1966 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
1968 $ui_diff tag conf dm
-foreground red
1969 $ui_diff tag conf dp
-foreground blue
1970 $ui_diff tag conf di
-foreground "#00a000"
1971 $ui_diff tag conf dni
-foreground "#a000a0"
1972 $ui_diff tag conf da
-font [concat
$font_diff bold
]
1973 $ui_diff tag conf bold
-font [concat
$font_diff bold
]
1975 # -- Diff Body Context Menu
1977 menu
$ui_diff.ctxm
-tearoff 0
1978 $ui_diff.ctxm add
command -label "Copy" \
1980 -command "tk_textCopy $ui_diff"
1981 $ui_diff.ctxm add
command -label "Select All" \
1983 -command "$ui_diff tag add sel 0.0 end"
1984 $ui_diff.ctxm add
command -label "Copy All" \
1987 $ui_diff tag add sel 0.0 end
1988 tk_textCopy $ui_diff
1989 $ui_diff tag remove sel 0.0 end
1991 $ui_diff.ctxm add separator
1992 $ui_diff.ctxm add
command -label "Decrease Font Size" \
1995 lset font_diff
1 [expr [lindex
$font_diff 1] - 1]
1996 $ui_diff configure
-font $font_diff
1997 $ui_diff tag conf da
-font [concat
$font_diff bold
]
1998 $ui_diff tag conf bold
-font [concat
$font_diff bold
]
2000 $ui_diff.ctxm add
command -label "Increase Font Size" \
2003 lset font_diff
1 [expr [lindex
$font_diff 1] + 1]
2004 $ui_diff configure
-font $font_diff
2005 $ui_diff tag conf da
-font [concat
$font_diff bold
]
2006 $ui_diff tag conf bold
-font [concat
$font_diff bold
]
2008 bind $ui_diff <Any-Button-3
> "tk_popup $ui_diff.ctxm %X %Y"
2011 set ui_status_value
{Initializing...
}
2012 label .status
-textvariable ui_status_value \
2018 pack .status
-anchor w
-side bottom
-fill x
2022 set gm
[lindex
$repo_config(gui.geometry
) 0]
2023 wm geometry .
[lindex
$gm 0]
2024 .vpane sash place
0 \
2025 [lindex
[.vpane sash coord
0] 0] \
2027 .vpane.files sash place
0 \
2029 [lindex
[.vpane.files sash coord
0] 1]
2034 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
2035 bind $ui_comm <$M1B-Key-i> {do_include_all
;break}
2036 bind $ui_comm <$M1B-Key-I> {do_include_all
;break}
2037 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
2038 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
2039 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
2040 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
2041 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
2042 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
2043 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2044 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2046 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
2047 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
2048 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
2049 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
2050 bind $ui_diff <$M1B-Key-v> {break}
2051 bind $ui_diff <$M1B-Key-V> {break}
2052 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
2053 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
2054 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
2055 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
2056 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
2057 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
2059 bind .
<Destroy
> do_quit
2060 bind all
<Key-F5
> do_rescan
2061 bind all
<$M1B-Key-r> do_rescan
2062 bind all
<$M1B-Key-R> do_rescan
2063 bind .
<$M1B-Key-s> do_signoff
2064 bind .
<$M1B-Key-S> do_signoff
2065 bind .
<$M1B-Key-i> do_include_all
2066 bind .
<$M1B-Key-I> do_include_all
2067 bind .
<$M1B-Key-Return> do_commit
2068 bind all
<$M1B-Key-q> do_quit
2069 bind all
<$M1B-Key-Q> do_quit
2070 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
2071 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
2072 foreach i
[list
$ui_index $ui_other] {
2073 bind $i <Button-1
> {click
%W
%x
%y
1 %X
%Y
; break}
2074 bind $i <Button-3
> {click
%W
%x
%y
3 %X
%Y
; break}
2075 bind $i <ButtonRelease-1
> {unclick
%W
%x
%y
; break}
2079 set file_lists
($ui_index) [list
]
2080 set file_lists
($ui_other) [list
]
2082 wm title .
"$appname ([file normalize [file dirname $gitdir]])"
2083 focus
-force $ui_comm
2085 populate_remote_menu .mbar.fetch From fetch_from
2086 populate_remote_menu .mbar.push To push_to
2087 populate_pull_menu .mbar.pull