2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GIT_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
9 This program is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
2 of the License
, or
12 (at your option
) any later version.
14 This program is distributed
in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License
for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program
; if not
, write to the Free Software
21 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
23 ######################################################################
27 set _appname
[lindex
[file split $argv0] end
]
41 return [eval [concat
[list
file join $_gitdir] $args]]
49 ######################################################################
53 proc is_many_config
{name
} {
54 switch
-glob -- $name {
63 proc load_config
{include_global
} {
64 global repo_config global_config default_config
66 array
unset global_config
67 if {$include_global} {
69 set fd_rc
[open
"| git repo-config --global --list" r
]
70 while {[gets
$fd_rc line
] >= 0} {
71 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
72 if {[is_many_config
$name]} {
73 lappend global_config
($name) $value
75 set global_config
($name) $value
83 array
unset repo_config
85 set fd_rc
[open
"| git repo-config --list" r
]
86 while {[gets
$fd_rc line
] >= 0} {
87 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
88 if {[is_many_config
$name]} {
89 lappend repo_config
($name) $value
91 set repo_config
($name) $value
98 foreach name
[array names default_config
] {
99 if {[catch
{set v
$global_config($name)}]} {
100 set global_config
($name) $default_config($name)
102 if {[catch
{set v
$repo_config($name)}]} {
103 set repo_config
($name) $default_config($name)
108 proc save_config
{} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
113 foreach option
$font_descs {
114 set name
[lindex
$option 0]
115 set font
[lindex
$option 1]
116 font configure
$font \
117 -family $global_config_new(gui.
$font^^family
) \
118 -size $global_config_new(gui.
$font^^size
)
119 font configure
${font}bold \
120 -family $global_config_new(gui.
$font^^family
) \
121 -size $global_config_new(gui.
$font^^size
)
122 set global_config_new
(gui.
$name) [font configure
$font]
123 unset global_config_new
(gui.
$font^^family
)
124 unset global_config_new
(gui.
$font^^size
)
127 foreach name
[array names default_config
] {
128 set value
$global_config_new($name)
129 if {$value ne
$global_config($name)} {
130 if {$value eq
$default_config($name)} {
131 catch
{exec git repo-config
--global --unset $name}
133 regsub
-all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
144 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
150 regsub -all "\
[{}\
]" $value {"} value
151 exec git repo-config
$name $value
153 set repo_config
($name) $value
158 proc error_popup
{msg
} {
160 if {[reponame
] ne
{}} {
161 append title
" ([reponame])"
163 set cmd
[list tk_messageBox \
166 -title "$title: error" \
168 if {[winfo ismapped .
]} {
169 lappend cmd
-parent .
174 proc warn_popup
{msg
} {
176 if {[reponame
] ne
{}} {
177 append title
" ([reponame])"
179 set cmd
[list tk_messageBox \
182 -title "$title: warning" \
184 if {[winfo ismapped .
]} {
185 lappend cmd
-parent .
190 proc info_popup
{msg
} {
192 if {[reponame
] ne
{}} {
193 append title
" ([reponame])"
203 proc ask_popup
{msg
} {
205 if {[reponame
] ne
{}} {
206 append title
" ([reponame])"
208 return [tk_messageBox \
216 ######################################################################
220 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
221 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
222 catch
{wm withdraw .
}
223 error_popup
"Cannot find the git directory:\n\n$err"
226 if {![file isdirectory
$_gitdir]} {
227 catch
{wm withdraw .
}
228 error_popup
"Git directory not found:\n\n$_gitdir"
231 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
232 catch
{wm withdraw .
}
233 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
236 if {[catch
{cd [file dirname $_gitdir]} err
]} {
237 catch
{wm withdraw .
}
238 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
241 set _reponame
[lindex
[file split \
242 [file normalize
[file dirname $_gitdir]]] \
246 if {[appname
] eq
{git-citool
}} {
250 ######################################################################
258 set disable_on_lock
[list
]
259 set index_lock_type none
261 proc lock_index
{type} {
262 global index_lock_type disable_on_lock
264 if {$index_lock_type eq
{none
}} {
265 set index_lock_type
$type
266 foreach w
$disable_on_lock {
267 uplevel
#0 $w disabled
270 } elseif
{$index_lock_type eq
"begin-$type"} {
271 set index_lock_type
$type
277 proc unlock_index
{} {
278 global index_lock_type disable_on_lock
280 set index_lock_type none
281 foreach w
$disable_on_lock {
286 ######################################################################
290 proc repository_state
{ctvar hdvar mhvar
} {
291 global current_branch
292 upvar
$ctvar ct
$hdvar hd
$mhvar mh
296 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
297 set current_branch
{}
299 regsub ^refs
/((heads|tags|remotes
)/)? \
305 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
311 set merge_head
[gitdir MERGE_HEAD
]
312 if {[file exists
$merge_head]} {
314 set fd_mh
[open
$merge_head r
]
315 while {[gets
$fd_mh line
] >= 0} {
326 global PARENT empty_tree
328 set p
[lindex
$PARENT 0]
332 if {$empty_tree eq
{}} {
333 set empty_tree
[exec git mktree
<< {}]
338 proc rescan
{after
{honor_trustmtime
1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
344 if {$rescan_active > 0 ||
![lock_index
read]} return
346 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend
* $commit_type]
348 && $newType eq
{normal
}
349 && $newHEAD eq
$HEAD} {
353 set MERGE_HEAD
$newMERGE_HEAD
354 set commit_type
$newType
357 array
unset file_states
359 if {![$ui_comm edit modified
]
360 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
361 if {[load_message GITGUI_MSG
]} {
362 } elseif
{[load_message MERGE_MSG
]} {
363 } elseif
{[load_message SQUASH_MSG
]} {
366 $ui_comm edit modified false
369 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
370 rescan_stage2
{} $after
373 set ui_status_value
{Refreshing
file status...
}
374 set cmd
[list git update-index
]
376 lappend cmd
--unmerged
377 lappend cmd
--ignore-missing
378 lappend cmd
--refresh
379 set fd_rf
[open
"| $cmd" r
]
380 fconfigure
$fd_rf -blocking 0 -translation binary
381 fileevent
$fd_rf readable \
382 [list rescan_stage2
$fd_rf $after]
386 proc rescan_stage2
{fd after
} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
392 if {![eof
$fd]} return
396 set ls_others
[list | git ls-files
--others -z \
397 --exclude-per-directory=.gitignore
]
398 set info_exclude
[gitdir info exclude
]
399 if {[file readable
$info_exclude]} {
400 lappend ls_others
"--exclude-from=$info_exclude"
408 set ui_status_value
{Scanning
for modified files ...
}
409 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
410 set fd_df
[open
"| git diff-files -z" r
]
411 set fd_lo
[open
$ls_others r
]
413 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
414 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
415 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
416 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
417 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
418 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
421 proc load_message
{file} {
425 if {[file isfile
$f]} {
426 if {[catch
{set fd
[open
$f r
]}]} {
429 set content
[string trim
[read $fd]]
431 $ui_comm delete
0.0 end
432 $ui_comm insert end
$content
438 proc read_diff_index
{fd after
} {
441 append buf_rdi
[read $fd]
443 set n
[string length
$buf_rdi]
445 set z1
[string first
"\0" $buf_rdi $c]
448 set z2
[string first
"\0" $buf_rdi $z1]
452 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
453 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
455 [encoding convertfrom
$p] \
457 [list
[lindex
$i 0] [lindex
$i 2]] \
463 set buf_rdi
[string range
$buf_rdi $c end
]
468 rescan_done
$fd buf_rdi
$after
471 proc read_diff_files
{fd after
} {
474 append buf_rdf
[read $fd]
476 set n
[string length
$buf_rdf]
478 set z1
[string first
"\0" $buf_rdf $c]
481 set z2
[string first
"\0" $buf_rdf $z1]
485 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
486 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
488 [encoding convertfrom
$p] \
491 [list
[lindex
$i 0] [lindex
$i 2]]
496 set buf_rdf
[string range
$buf_rdf $c end
]
501 rescan_done
$fd buf_rdf
$after
504 proc read_ls_others
{fd after
} {
507 append buf_rlo
[read $fd]
508 set pck
[split $buf_rlo "\0"]
509 set buf_rlo
[lindex
$pck end
]
510 foreach p
[lrange
$pck 0 end-1
] {
511 merge_state
[encoding convertfrom
$p] ?O
513 rescan_done
$fd buf_rlo
$after
516 proc rescan_done
{fd buf after
} {
518 global file_states repo_config
521 if {![eof
$fd]} return
524 if {[incr rescan_active
-1] > 0} return
533 proc prune_selection
{} {
534 global file_states selected_paths
536 foreach path
[array names selected_paths
] {
537 if {[catch
{set still_here
$file_states($path)}]} {
538 unset selected_paths
($path)
543 ######################################################################
548 global ui_diff current_diff_path current_diff_header
549 global ui_index ui_workdir
551 $ui_diff conf
-state normal
552 $ui_diff delete
0.0 end
553 $ui_diff conf
-state disabled
555 set current_diff_path
{}
556 set current_diff_header
{}
558 $ui_index tag remove in_diff
0.0 end
559 $ui_workdir tag remove in_diff
0.0 end
562 proc reshow_diff
{} {
563 global ui_status_value file_states file_lists
564 global current_diff_path current_diff_side
566 set p
$current_diff_path
568 ||
$current_diff_side eq
{}
569 ||
[catch
{set s
$file_states($p)}]
570 ||
[lsearch
-sorted $file_lists($current_diff_side) $p] == -1} {
573 show_diff
$p $current_diff_side
577 proc handle_empty_diff
{} {
578 global current_diff_path file_states file_lists
580 set path
$current_diff_path
581 set s
$file_states($path)
582 if {[lindex
$s 0] ne
{_M
}} return
584 info_popup
"No differences detected.
586 [short_path $path] has no changes.
588 The modification date of this file was updated
589 by another application, but the content within
590 the file was not changed.
592 A rescan will be automatically started to find
593 other files which may have the same state."
596 display_file
$path __
597 rescan
{set ui_status_value
{Ready.
}} 0
600 proc show_diff
{path w
{lno
{}}} {
601 global file_states file_lists
602 global is_3way_diff diff_active repo_config
603 global ui_diff ui_status_value ui_index ui_workdir
604 global current_diff_path current_diff_side current_diff_header
606 if {$diff_active ||
![lock_index
read]} return
609 if {$w eq
{} ||
$lno == {}} {
610 foreach w
[array names file_lists
] {
611 set lno
[lsearch
-sorted $file_lists($w) $path]
618 if {$w ne
{} && $lno >= 1} {
619 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
622 set s
$file_states($path)
626 set current_diff_path
$path
627 set current_diff_side
$w
628 set current_diff_header
{}
629 set ui_status_value
"Loading diff of [escape_path $path]..."
631 # - Git won't give us the diff, there's nothing to compare to!
634 set max_sz
[expr {128 * 1024}]
636 set fd
[open
$path r
]
637 set content
[read $fd $max_sz]
639 set sz
[file size
$path]
643 set ui_status_value
"Unable to display [escape_path $path]"
644 error_popup
"Error loading file:\n\n$err"
647 $ui_diff conf
-state normal
648 if {![catch
{set type [exec file $path]}]} {
649 set n
[string length
$path]
650 if {[string equal
-length $n $path $type]} {
651 set type [string range
$type $n end
]
652 regsub
{^
:?\s
*} $type {} type
654 $ui_diff insert end
"* $type\n" d_@
656 if {[string first
"\0" $content] != -1} {
657 $ui_diff insert end \
658 "* Binary file (not showing content)." \
662 $ui_diff insert end \
663 "* Untracked file is $sz bytes.
664 * Showing only first $max_sz bytes.
667 $ui_diff insert end
$content
669 $ui_diff insert end
"
670 * Untracked file clipped here by [appname].
671 * To see the entire file, use an external editor.
675 $ui_diff conf
-state disabled
678 set ui_status_value
{Ready.
}
683 if {$w eq
$ui_index} {
684 lappend cmd diff-index
686 } elseif
{$w eq
$ui_workdir} {
687 if {[string index
$m 0] eq
{U
}} {
690 lappend cmd diff-files
695 lappend cmd
--no-color
696 if {$repo_config(gui.diffcontext
) > 0} {
697 lappend cmd
"-U$repo_config(gui.diffcontext)"
699 if {$w eq
$ui_index} {
705 if {[catch
{set fd
[open
$cmd r
]} err
]} {
708 set ui_status_value
"Unable to display [escape_path $path]"
709 error_popup
"Error loading diff:\n\n$err"
717 fileevent
$fd readable
[list read_diff
$fd]
720 proc read_diff
{fd
} {
721 global ui_diff ui_status_value diff_active
722 global is_3way_diff current_diff_header
724 $ui_diff conf
-state normal
725 while {[gets
$fd line
] >= 0} {
726 # -- Cleanup uninteresting diff header lines.
728 if { [string match
{diff --git *} $line]
729 ||
[string match
{diff --cc *} $line]
730 ||
[string match
{diff --combined *} $line]
731 ||
[string match
{--- *} $line]
732 ||
[string match
{+++ *} $line]} {
733 append current_diff_header
$line "\n"
736 if {[string match
{index
*} $line]} continue
737 if {$line eq
{deleted
file mode
120000}} {
738 set line
"deleted symlink"
741 # -- Automatically detect if this is a 3 way diff.
743 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
745 if {[string match
{mode
*} $line]
746 ||
[string match
{new
file *} $line]
747 ||
[string match
{deleted
file *} $line]
748 ||
[string match
{Binary files
* and
* differ
} $line]
749 ||
$line eq
{\ No newline
at end of
file}
750 ||
[regexp
{^\
* Unmerged path
} $line]} {
752 } elseif
{$is_3way_diff} {
753 set op
[string range
$line 0 1]
763 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
764 set line
[string replace
$line 0 1 { }]
771 puts
"error: Unhandled 3 way diff marker: {$op}"
776 set op
[string index
$line 0]
782 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
783 set line
[string replace
$line 0 0 { }]
790 puts
"error: Unhandled 2 way diff marker: {$op}"
795 $ui_diff insert end
$line $tags
796 $ui_diff insert end
"\n" $tags
798 $ui_diff conf
-state disabled
804 set ui_status_value
{Ready.
}
806 if {[$ui_diff index end
] eq
{2.0}} {
812 proc apply_hunk
{x y
} {
813 global current_diff_path current_diff_header current_diff_side
814 global ui_diff ui_index file_states
816 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
817 if {![lock_index apply_hunk
]} return
819 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
820 set mi
[lindex
$file_states($current_diff_path) 0]
821 if {$current_diff_side eq
$ui_index} {
823 lappend apply_cmd
--reverse
824 if {[string index
$mi 0] ne
{M
}} {
830 if {[string index
$mi 1] ne
{M
}} {
836 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
837 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
843 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
849 set p
[open
"| $apply_cmd" w
]
850 fconfigure
$p -translation binary
-encoding binary
851 puts
-nonewline $p $current_diff_header
852 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
854 error_popup
"Failed to $mode selected hunk.\n\n$err"
859 $ui_diff conf
-state normal
860 $ui_diff delete
$s_lno $e_lno
861 $ui_diff conf
-state disabled
863 if {[$ui_diff get
1.0 end
] eq
"\n"} {
869 if {$current_diff_side eq
$ui_index} {
871 } elseif
{[string index
$mi 0] eq
{_
}} {
877 display_file
$current_diff_path $mi
883 ######################################################################
887 proc load_last_commit
{} {
888 global HEAD PARENT MERGE_HEAD commit_type ui_comm
891 if {[llength
$PARENT] == 0} {
892 error_popup
{There is nothing to amend.
894 You are about to create the initial commit.
895 There is no commit before this to amend.
900 repository_state curType curHEAD curMERGE_HEAD
901 if {$curType eq
{merge
}} {
902 error_popup
{Cannot amend
while merging.
904 You are currently
in the middle of a merge that
905 has not been fully completed. You cannot amend
906 the prior commit unless you first abort the
907 current merge activity.
915 set fd
[open
"| git cat-file commit $curHEAD" r
]
916 fconfigure
$fd -encoding binary
-translation lf
917 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
920 while {[gets
$fd line
] > 0} {
921 if {[string match
{parent
*} $line]} {
922 lappend parents
[string range
$line 7 end
]
923 } elseif
{[string match
{encoding
*} $line]} {
924 set enc
[string tolower
[string range
$line 9 end
]]
927 fconfigure
$fd -encoding $enc
928 set msg
[string trim
[read $fd]]
931 error_popup
"Error loading commit data for amend:\n\n$err"
937 set MERGE_HEAD
[list
]
938 switch
-- [llength
$parents] {
939 0 {set commit_type amend-initial
}
940 1 {set commit_type amend
}
941 default
{set commit_type amend-merge
}
944 $ui_comm delete
0.0 end
945 $ui_comm insert end
$msg
947 $ui_comm edit modified false
948 rescan
{set ui_status_value
{Ready.
}}
951 proc create_new_commit
{} {
952 global commit_type ui_comm
954 set commit_type normal
955 $ui_comm delete
0.0 end
957 $ui_comm edit modified false
958 rescan
{set ui_status_value
{Ready.
}}
961 set GIT_COMMITTER_IDENT
{}
963 proc committer_ident
{} {
964 global GIT_COMMITTER_IDENT
966 if {$GIT_COMMITTER_IDENT eq
{}} {
967 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
968 error_popup
"Unable to obtain your identity:\n\n$err"
971 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
972 $me me GIT_COMMITTER_IDENT
]} {
973 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
978 return $GIT_COMMITTER_IDENT
981 proc commit_tree
{} {
982 global HEAD commit_type file_states ui_comm repo_config
983 global ui_status_value pch_error
985 if {![lock_index update
]} return
986 if {[committer_ident
] eq
{}} return
988 # -- Our in memory state should match the repository.
990 repository_state curType curHEAD curMERGE_HEAD
991 if {[string match amend
* $commit_type]
992 && $curType eq
{normal
}
993 && $curHEAD eq
$HEAD} {
994 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
995 info_popup
{Last scanned state does not match repository state.
997 Another Git program has modified this repository
998 since the last scan. A rescan must be performed
999 before another commit can be created.
1001 The rescan will be automatically started now.
1004 rescan
{set ui_status_value
{Ready.
}}
1008 # -- At least one file should differ in the index.
1011 foreach path
[array names file_states
] {
1012 switch
-glob -- [lindex
$file_states($path) 0] {
1016 M?
{set files_ready
1}
1018 error_popup
"Unmerged files cannot be committed.
1020 File [short_path $path] has merge conflicts.
1021 You must resolve them and add the file before committing.
1027 error_popup
"Unknown file state [lindex $s 0] detected.
1029 File [short_path $path] cannot be committed by this program.
1034 if {!$files_ready} {
1035 info_popup
{No changes to commit.
1037 You must add
at least
1 file before you can commit.
1043 # -- A message is required.
1045 set msg
[string trim
[$ui_comm get
1.0 end
]]
1047 error_popup
{Please supply a commit message.
1049 A good commit message has the following format
:
1051 - First line
: Describe
in one sentance what you did.
1052 - Second line
: Blank
1053 - Remaining lines
: Describe why this change is good.
1059 # -- Run the pre-commit hook.
1061 set pchook
[gitdir hooks pre-commit
]
1063 # On Cygwin [file executable] might lie so we need to ask
1064 # the shell if the hook is executable. Yes that's annoying.
1066 if {[is_Windows
] && [file isfile
$pchook]} {
1067 set pchook
[list sh
-c [concat \
1068 "if test -x \"$pchook\";" \
1069 "then exec \"$pchook\" 2>&1;" \
1071 } elseif
{[file executable
$pchook]} {
1072 set pchook
[list
$pchook |
& cat]
1074 commit_writetree
$curHEAD $msg
1078 set ui_status_value
{Calling pre-commit hook...
}
1080 set fd_ph
[open
"| $pchook" r
]
1081 fconfigure
$fd_ph -blocking 0 -translation binary
1082 fileevent
$fd_ph readable \
1083 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1086 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1087 global pch_error ui_status_value
1089 append pch_error
[read $fd_ph]
1090 fconfigure
$fd_ph -blocking 1
1092 if {[catch
{close
$fd_ph}]} {
1093 set ui_status_value
{Commit declined by pre-commit hook.
}
1094 hook_failed_popup pre-commit
$pch_error
1097 commit_writetree
$curHEAD $msg
1102 fconfigure
$fd_ph -blocking 0
1105 proc commit_writetree
{curHEAD msg
} {
1106 global ui_status_value
1108 set ui_status_value
{Committing changes...
}
1109 set fd_wt
[open
"| git write-tree" r
]
1110 fileevent
$fd_wt readable \
1111 [list commit_committree
$fd_wt $curHEAD $msg]
1114 proc commit_committree
{fd_wt curHEAD msg
} {
1115 global HEAD PARENT MERGE_HEAD commit_type
1116 global single_commit all_heads current_branch
1117 global ui_status_value ui_comm selected_commit_type
1118 global file_states selected_paths rescan_active
1122 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1123 error_popup
"write-tree failed:\n\n$err"
1124 set ui_status_value
{Commit failed.
}
1129 # -- Build the message.
1131 set msg_p
[gitdir COMMIT_EDITMSG
]
1132 set msg_wt
[open
$msg_p w
]
1133 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1136 fconfigure
$msg_wt -encoding $enc -translation binary
1137 puts
-nonewline $msg_wt $msg
1140 # -- Create the commit.
1142 set cmd
[list git commit-tree
$tree_id]
1143 set parents
[concat
$PARENT $MERGE_HEAD]
1144 if {[llength
$parents] > 0} {
1145 foreach p
$parents {
1149 # git commit-tree writes to stderr during initial commit.
1150 lappend cmd
2>/dev
/null
1153 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1154 error_popup
"commit-tree failed:\n\n$err"
1155 set ui_status_value
{Commit failed.
}
1160 # -- Update the HEAD ref.
1163 if {$commit_type ne
{normal
}} {
1164 append reflogm
" ($commit_type)"
1166 set i
[string first
"\n" $msg]
1168 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1170 append reflogm
{: } $msg
1172 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1173 if {[catch
{eval exec $cmd} err
]} {
1174 error_popup
"update-ref failed:\n\n$err"
1175 set ui_status_value
{Commit failed.
}
1180 # -- Make sure our current branch exists.
1182 if {$commit_type eq
{initial
}} {
1183 lappend all_heads
$current_branch
1184 set all_heads
[lsort
-unique $all_heads]
1185 populate_branch_menu
1188 # -- Cleanup after ourselves.
1190 catch
{file delete
$msg_p}
1191 catch
{file delete
[gitdir MERGE_HEAD
]}
1192 catch
{file delete
[gitdir MERGE_MSG
]}
1193 catch
{file delete
[gitdir SQUASH_MSG
]}
1194 catch
{file delete
[gitdir GITGUI_MSG
]}
1196 # -- Let rerere do its thing.
1198 if {[file isdirectory
[gitdir rr-cache
]]} {
1199 catch
{exec git rerere
}
1202 # -- Run the post-commit hook.
1204 set pchook
[gitdir hooks post-commit
]
1205 if {[is_Windows
] && [file isfile
$pchook]} {
1206 set pchook
[list sh
-c [concat \
1207 "if test -x \"$pchook\";" \
1208 "then exec \"$pchook\";" \
1210 } elseif
{![file executable
$pchook]} {
1213 if {$pchook ne
{}} {
1214 catch
{exec $pchook &}
1217 $ui_comm delete
0.0 end
1219 $ui_comm edit modified false
1221 if {$single_commit} do_quit
1223 # -- Update in memory status
1225 set selected_commit_type new
1226 set commit_type normal
1229 set MERGE_HEAD
[list
]
1231 foreach path
[array names file_states
] {
1232 set s
$file_states($path)
1234 switch
-glob -- $m {
1242 unset file_states
($path)
1243 catch
{unset selected_paths
($path)}
1246 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1252 set file_states
($path) [list \
1253 _
[string index
$m 1] \
1264 set ui_status_value \
1265 "Changes committed as [string range $cmt_id 0 7]."
1268 ######################################################################
1272 proc fetch_from
{remote
} {
1273 set w
[new_console
"fetch $remote" \
1274 "Fetching new changes from $remote"]
1275 set cmd
[list git fetch
]
1277 console_exec
$w $cmd
1280 proc pull_remote
{remote branch
} {
1281 global HEAD commit_type file_states repo_config
1283 if {![lock_index update
]} return
1285 # -- Our in memory state should match the repository.
1287 repository_state curType curHEAD curMERGE_HEAD
1288 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1289 info_popup
{Last scanned state does not match repository state.
1291 Another Git program has modified this repository
1292 since the last scan. A rescan must be performed
1293 before a pull operation can be started.
1295 The rescan will be automatically started now.
1298 rescan
{set ui_status_value
{Ready.
}}
1302 # -- No differences should exist before a pull.
1304 if {[array size file_states
] != 0} {
1305 error_popup
{Uncommitted but modified files are present.
1307 You should not perform a pull with unmodified
1308 files
in your working directory as Git will be
1309 unable to recover from an incorrect merge.
1311 You should commit or revert all changes before
1312 starting a pull operation.
1318 set w
[new_console
"pull $remote $branch" \
1319 "Pulling new changes from branch $branch in $remote"]
1320 set cmd
[list git pull
]
1321 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1322 lappend cmd
--no-summary
1326 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1329 proc post_pull_remote
{remote branch success
} {
1330 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1331 global ui_status_value
1335 repository_state commit_type HEAD MERGE_HEAD
1337 set selected_commit_type new
1338 set ui_status_value
"Pulling $branch from $remote complete."
1340 rescan
[list
set ui_status_value \
1341 "Conflicts detected while pulling $branch from $remote."]
1345 proc push_to
{remote
} {
1346 set w
[new_console
"push $remote" \
1347 "Pushing changes to $remote"]
1348 set cmd
[list git push
]
1350 console_exec
$w $cmd
1353 ######################################################################
1357 proc mapicon
{w state path
} {
1360 if {[catch
{set r
$all_icons($state$w)}]} {
1361 puts
"error: no icon for $w state={$state} $path"
1367 proc mapdesc
{state path
} {
1370 if {[catch
{set r
$all_descs($state)}]} {
1371 puts
"error: no desc for state={$state} $path"
1377 proc escape_path
{path
} {
1378 regsub
-all "\n" $path "\\n" path
1382 proc short_path
{path
} {
1383 return [escape_path
[lindex
[file split $path] end
]]
1387 set null_sha1
[string repeat
0 40]
1389 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1390 global file_states next_icon_id null_sha1
1392 set s0
[string index
$new_state 0]
1393 set s1
[string index
$new_state 1]
1395 if {[catch
{set info
$file_states($path)}]} {
1397 set icon n
[incr next_icon_id
]
1399 set state
[lindex
$info 0]
1400 set icon
[lindex
$info 1]
1401 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1402 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1405 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1406 elseif
{$s0 eq
{_
}} {set s0 _
}
1408 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1409 elseif
{$s1 eq
{_
}} {set s1 _
}
1411 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1412 set head_info
[list
0 $null_sha1]
1413 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1414 && $head_info eq
{}} {
1415 set head_info
$index_info
1418 set file_states
($path) [list
$s0$s1 $icon \
1419 $head_info $index_info \
1424 proc display_file_helper
{w path icon_name old_m new_m
} {
1427 if {$new_m eq
{_
}} {
1428 set lno
[lsearch
-sorted $file_lists($w) $path]
1430 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1432 $w conf
-state normal
1433 $w delete
$lno.0 [expr {$lno + 1}].0
1434 $w conf
-state disabled
1436 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1437 lappend file_lists
($w) $path
1438 set file_lists
($w) [lsort
-unique $file_lists($w)]
1439 set lno
[lsearch
-sorted $file_lists($w) $path]
1441 $w conf
-state normal
1442 $w image create
$lno.0 \
1443 -align center
-padx 5 -pady 1 \
1445 -image [mapicon
$w $new_m $path]
1446 $w insert
$lno.1 "[escape_path $path]\n"
1447 $w conf
-state disabled
1448 } elseif
{$old_m ne
$new_m} {
1449 $w conf
-state normal
1450 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1451 $w conf
-state disabled
1455 proc display_file
{path state
} {
1456 global file_states selected_paths
1457 global ui_index ui_workdir
1459 set old_m
[merge_state
$path $state]
1460 set s
$file_states($path)
1461 set new_m
[lindex
$s 0]
1462 set icon_name
[lindex
$s 1]
1464 set o
[string index
$old_m 0]
1465 set n
[string index
$new_m 0]
1472 display_file_helper
$ui_index $path $icon_name $o $n
1474 if {[string index
$old_m 0] eq
{U
}} {
1477 set o
[string index
$old_m 1]
1479 if {[string index
$new_m 0] eq
{U
}} {
1482 set n
[string index
$new_m 1]
1484 display_file_helper
$ui_workdir $path $icon_name $o $n
1486 if {$new_m eq
{__
}} {
1487 unset file_states
($path)
1488 catch
{unset selected_paths
($path)}
1492 proc display_all_files_helper
{w path icon_name m
} {
1495 lappend file_lists
($w) $path
1496 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1497 $w image create end \
1498 -align center
-padx 5 -pady 1 \
1500 -image [mapicon
$w $m $path]
1501 $w insert end
"[escape_path $path]\n"
1504 proc display_all_files
{} {
1505 global ui_index ui_workdir
1506 global file_states file_lists
1509 $ui_index conf
-state normal
1510 $ui_workdir conf
-state normal
1512 $ui_index delete
0.0 end
1513 $ui_workdir delete
0.0 end
1516 set file_lists
($ui_index) [list
]
1517 set file_lists
($ui_workdir) [list
]
1519 foreach path
[lsort
[array names file_states
]] {
1520 set s
$file_states($path)
1522 set icon_name
[lindex
$s 1]
1524 set s
[string index
$m 0]
1525 if {$s ne
{U
} && $s ne
{_
}} {
1526 display_all_files_helper
$ui_index $path \
1530 if {[string index
$m 0] eq
{U
}} {
1533 set s
[string index
$m 1]
1536 display_all_files_helper
$ui_workdir $path \
1541 $ui_index conf
-state disabled
1542 $ui_workdir conf
-state disabled
1545 proc update_indexinfo
{msg pathList after
} {
1546 global update_index_cp ui_status_value
1548 if {![lock_index update
]} return
1550 set update_index_cp
0
1551 set pathList
[lsort
$pathList]
1552 set totalCnt
[llength
$pathList]
1553 set batch [expr {int
($totalCnt * .01) + 1}]
1554 if {$batch > 25} {set batch 25}
1556 set ui_status_value
[format \
1557 "$msg... %i/%i files (%.2f%%)" \
1561 set fd
[open
"| git update-index -z --index-info" w
]
1568 fileevent
$fd writable
[list \
1569 write_update_indexinfo \
1579 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1580 global update_index_cp ui_status_value
1581 global file_states current_diff_path
1583 if {$update_index_cp >= $totalCnt} {
1590 for {set i
$batch} \
1591 {$update_index_cp < $totalCnt && $i > 0} \
1593 set path
[lindex
$pathList $update_index_cp]
1594 incr update_index_cp
1596 set s
$file_states($path)
1597 switch
-glob -- [lindex
$s 0] {
1604 set info
[lindex
$s 2]
1605 if {$info eq
{}} continue
1607 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1608 display_file
$path $new
1611 set ui_status_value
[format \
1612 "$msg... %i/%i files (%.2f%%)" \
1615 [expr {100.0 * $update_index_cp / $totalCnt}]]
1618 proc update_index
{msg pathList after
} {
1619 global update_index_cp ui_status_value
1621 if {![lock_index update
]} return
1623 set update_index_cp
0
1624 set pathList
[lsort
$pathList]
1625 set totalCnt
[llength
$pathList]
1626 set batch [expr {int
($totalCnt * .01) + 1}]
1627 if {$batch > 25} {set batch 25}
1629 set ui_status_value
[format \
1630 "$msg... %i/%i files (%.2f%%)" \
1634 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1641 fileevent
$fd writable
[list \
1642 write_update_index \
1652 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1653 global update_index_cp ui_status_value
1654 global file_states current_diff_path
1656 if {$update_index_cp >= $totalCnt} {
1663 for {set i
$batch} \
1664 {$update_index_cp < $totalCnt && $i > 0} \
1666 set path
[lindex
$pathList $update_index_cp]
1667 incr update_index_cp
1669 switch
-glob -- [lindex
$file_states($path) 0] {
1675 if {[file exists
$path]} {
1684 puts
-nonewline $fd "[encoding convertto $path]\0"
1685 display_file
$path $new
1688 set ui_status_value
[format \
1689 "$msg... %i/%i files (%.2f%%)" \
1692 [expr {100.0 * $update_index_cp / $totalCnt}]]
1695 proc checkout_index
{msg pathList after
} {
1696 global update_index_cp ui_status_value
1698 if {![lock_index update
]} return
1700 set update_index_cp
0
1701 set pathList
[lsort
$pathList]
1702 set totalCnt
[llength
$pathList]
1703 set batch [expr {int
($totalCnt * .01) + 1}]
1704 if {$batch > 25} {set batch 25}
1706 set ui_status_value
[format \
1707 "$msg... %i/%i files (%.2f%%)" \
1711 set cmd
[list git checkout-index
]
1717 set fd
[open
"| $cmd " w
]
1724 fileevent
$fd writable
[list \
1725 write_checkout_index \
1735 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1736 global update_index_cp ui_status_value
1737 global file_states current_diff_path
1739 if {$update_index_cp >= $totalCnt} {
1746 for {set i
$batch} \
1747 {$update_index_cp < $totalCnt && $i > 0} \
1749 set path
[lindex
$pathList $update_index_cp]
1750 incr update_index_cp
1751 switch
-glob -- [lindex
$file_states($path) 0] {
1755 puts
-nonewline $fd "[encoding convertto $path]\0"
1756 display_file
$path ?_
1761 set ui_status_value
[format \
1762 "$msg... %i/%i files (%.2f%%)" \
1765 [expr {100.0 * $update_index_cp / $totalCnt}]]
1768 ######################################################################
1770 ## branch management
1772 proc is_tracking_branch
{name
} {
1773 global tracking_branches
1775 if {![catch
{set info
$tracking_branches($name)}]} {
1778 foreach t
[array names tracking_branches
] {
1779 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1786 proc load_all_heads
{} {
1789 set all_heads
[list
]
1790 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1791 while {[gets
$fd line
] > 0} {
1792 if {[is_tracking_branch
$line]} continue
1793 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1794 lappend all_heads
$name
1798 set all_heads
[lsort
$all_heads]
1801 proc populate_branch_menu
{} {
1802 global all_heads disable_on_lock
1805 set last
[$m index last
]
1806 for {set i
0} {$i <= $last} {incr i
} {
1807 if {[$m type $i] eq
{separator
}} {
1810 foreach a
$disable_on_lock {
1811 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1815 set disable_on_lock
$new_dol
1821 foreach b
$all_heads {
1822 $m add radiobutton \
1824 -command [list switch_branch
$b] \
1825 -variable current_branch \
1828 lappend disable_on_lock \
1829 [list
$m entryconf
[$m index last
] -state]
1833 proc all_tracking_branches
{} {
1834 global tracking_branches
1836 set all_trackings
{}
1838 foreach name
[array names tracking_branches
] {
1839 if {[regsub
{/\
*$
} $name {} name
]} {
1842 regsub ^refs
/(heads|remotes
)/ $name {} name
1843 lappend all_trackings
$name
1848 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1849 while {[gets
$fd name
] > 0} {
1850 regsub ^refs
/(heads|remotes
)/ $name {} name
1851 lappend all_trackings
$name
1856 return [lsort
-unique $all_trackings]
1859 proc do_create_branch_action
{w
} {
1860 global all_heads null_sha1 repo_config
1861 global create_branch_checkout create_branch_revtype
1862 global create_branch_head create_branch_trackinghead
1864 set newbranch
[string trim
[$w.desc.name_t get
0.0 end
]]
1865 if {$newbranch eq
{}
1866 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1870 -title [wm title
$w] \
1872 -message "Please supply a branch name."
1873 focus
$w.desc.name_t
1876 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1880 -title [wm title
$w] \
1882 -message "Branch '$newbranch' already exists."
1883 focus
$w.desc.name_t
1886 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1890 -title [wm title
$w] \
1892 -message "We do not like '$newbranch' as a branch name."
1893 focus
$w.desc.name_t
1898 switch
-- $create_branch_revtype {
1899 head {set rev $create_branch_head}
1900 tracking
{set rev $create_branch_trackinghead}
1901 expression
{set rev [string trim
[$w.from.exp_t get
0.0 end
]]}
1903 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1907 -title [wm title
$w] \
1909 -message "Invalid starting revision: $rev"
1912 set cmd
[list git update-ref
]
1914 lappend cmd
"branch: Created from $rev"
1915 lappend cmd
"refs/heads/$newbranch"
1917 lappend cmd
$null_sha1
1918 if {[catch
{eval exec $cmd} err
]} {
1922 -title [wm title
$w] \
1924 -message "Failed to create '$newbranch'.\n\n$err"
1928 lappend all_heads
$newbranch
1929 set all_heads
[lsort
$all_heads]
1930 populate_branch_menu
1932 if {$create_branch_checkout} {
1933 switch_branch
$newbranch
1937 proc radio_selector
{varname value args
} {
1938 upvar
#0 $varname var
1942 trace add variable create_branch_head
write \
1943 [list radio_selector create_branch_revtype
head]
1944 trace add variable create_branch_trackinghead
write \
1945 [list radio_selector create_branch_revtype tracking
]
1947 trace add variable delete_branch_head
write \
1948 [list radio_selector delete_branch_checktype
head]
1949 trace add variable delete_branch_trackinghead
write \
1950 [list radio_selector delete_branch_checktype tracking
]
1952 proc do_create_branch
{} {
1953 global all_heads current_branch repo_config
1954 global create_branch_checkout create_branch_revtype
1955 global create_branch_head create_branch_trackinghead
1957 set w .branch_editor
1959 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1961 label
$w.header
-text {Create New Branch
} \
1963 pack
$w.header
-side top
-fill x
1966 button
$w.buttons.create
-text Create \
1969 -command [list do_create_branch_action
$w]
1970 pack
$w.buttons.create
-side right
1971 button
$w.buttons.cancel
-text {Cancel
} \
1973 -command [list destroy
$w]
1974 pack
$w.buttons.cancel
-side right
-padx 5
1975 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1977 labelframe
$w.desc \
1978 -text {Branch Description
} \
1980 label
$w.desc.name_l
-text {Name
:} -font font_ui
1981 text
$w.desc.name_t \
1987 $w.desc.name_t insert
0.0 $repo_config(gui.newbranchtemplate
)
1988 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
1989 bind $w.desc.name_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
1990 bind $w.desc.name_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
1991 bind $w.desc.name_t
<Key-Return
> "do_create_branch_action $w;break"
1992 bind $w.desc.name_t
<Key
> {
1993 if {{%K
} ne
{BackSpace
}
1996 && {%K
} ne
{Return
}} {
1998 if {[string first
%A
{~^
:?
*[}] >= 0} break
2001 grid columnconfigure
$w.desc
1 -weight 1
2002 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2004 labelframe
$w.from \
2005 -text {Starting Revision
} \
2007 radiobutton
$w.from.head_r \
2008 -text {Local Branch
:} \
2010 -variable create_branch_revtype \
2012 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2013 grid
$w.from.head_r
$w.from.head_m
-sticky w
2014 set all_trackings
[all_tracking_branches
]
2015 if {$all_trackings ne
{}} {
2016 set create_branch_trackinghead
[lindex
$all_trackings 0]
2017 radiobutton
$w.from.tracking_r \
2018 -text {Tracking Branch
:} \
2020 -variable create_branch_revtype \
2022 eval tk_optionMenu
$w.from.tracking_m \
2023 create_branch_trackinghead \
2025 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2027 radiobutton
$w.from.exp_r \
2028 -text {Revision Expression
:} \
2030 -variable create_branch_revtype \
2032 text
$w.from.exp_t \
2038 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2039 bind $w.from.exp_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
2040 bind $w.from.exp_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
2041 bind $w.from.exp_t
<Key-Return
> "do_create_branch_action $w;break"
2042 bind $w.from.exp_t
<Key-space
> break
2043 bind $w.from.exp_t
<Key
> {set create_branch_revtype expression
}
2044 grid columnconfigure
$w.from
1 -weight 1
2045 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2047 labelframe
$w.postActions \
2048 -text {Post Creation Actions
} \
2050 checkbutton
$w.postActions.checkout \
2051 -text {Checkout after creation
} \
2052 -variable create_branch_checkout \
2054 pack
$w.postActions.checkout
-anchor nw
2055 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2057 set create_branch_checkout
1
2058 set create_branch_head
$current_branch
2059 set create_branch_revtype
head
2061 bind $w <Visibility
> "grab $w; focus $w.desc.name_t"
2062 bind $w <Key-Escape
> "destroy $w"
2063 bind $w <Key-Return
> "do_create_branch_action $w;break"
2064 wm title
$w "[appname] ([reponame]): Create Branch"
2068 proc do_delete_branch_action
{w
} {
2070 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2073 switch
-- $delete_branch_checktype {
2074 head {set check_rev
$delete_branch_head}
2075 tracking
{set check_rev
$delete_branch_trackinghead}
2076 always
{set check_rev
{:none
}}
2078 if {$check_rev eq
{:none
}} {
2080 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2084 -title [wm title
$w] \
2086 -message "Invalid check revision: $check_rev"
2090 set to_delete
[list
]
2091 set not_merged
[list
]
2092 foreach i
[$w.list.l curselection
] {
2093 set b
[$w.list.l get
$i]
2094 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2095 if {$check_cmt ne
{}} {
2096 if {$b eq
$check_rev} continue
2097 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2099 lappend not_merged
$b
2103 lappend to_delete
[list
$b $o]
2105 if {$not_merged ne
{}} {
2106 set msg
"The following branches are not completely merged into $check_rev:
2108 - [join $not_merged "\n - "]"
2112 -title [wm title
$w] \
2116 if {$to_delete eq
{}} return
2117 if {$delete_branch_checktype eq
{always
}} {
2118 set msg
{Recovering deleted branches is difficult.
2120 Delete the selected branches?
}
2121 if {[tk_messageBox \
2124 -title [wm title
$w] \
2126 -message $msg] ne
yes} {
2132 foreach i
$to_delete {
2135 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2136 append failed
" - $b: $err\n"
2138 set x
[lsearch
-sorted $all_heads $b]
2140 set all_heads
[lreplace
$all_heads $x $x]
2145 if {$failed ne
{}} {
2149 -title [wm title
$w] \
2151 -message "Failed to delete branches:\n$failed"
2154 set all_heads
[lsort
$all_heads]
2155 populate_branch_menu
2159 proc do_delete_branch
{} {
2160 global all_heads tracking_branches current_branch
2161 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2163 set w .branch_editor
2165 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2167 label
$w.header
-text {Delete Local Branch
} \
2169 pack
$w.header
-side top
-fill x
2172 button
$w.buttons.create
-text Delete \
2174 -command [list do_delete_branch_action
$w]
2175 pack
$w.buttons.create
-side right
2176 button
$w.buttons.cancel
-text {Cancel
} \
2178 -command [list destroy
$w]
2179 pack
$w.buttons.cancel
-side right
-padx 5
2180 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2182 labelframe
$w.list \
2183 -text {Local Branches
} \
2188 -selectmode extended \
2190 foreach h
$all_heads {
2191 if {$h ne
$current_branch} {
2192 $w.list.l insert end
$h
2195 pack
$w.list.l
-fill both
-pady 5 -padx 5
2196 pack
$w.list
-fill both
-pady 5 -padx 5
2198 labelframe
$w.validate \
2199 -text {Delete Only If
} \
2201 radiobutton
$w.validate.head_r \
2202 -text {Merged Into Local Branch
:} \
2204 -variable delete_branch_checktype \
2206 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2207 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2208 set all_trackings
[all_tracking_branches
]
2209 if {$all_trackings ne
{}} {
2210 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2211 radiobutton
$w.validate.tracking_r \
2212 -text {Merged Into Tracking Branch
:} \
2214 -variable delete_branch_checktype \
2216 eval tk_optionMenu
$w.validate.tracking_m \
2217 delete_branch_trackinghead \
2219 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2221 radiobutton
$w.validate.always_r \
2222 -text {Always
(Do not perform merge checks
)} \
2224 -variable delete_branch_checktype \
2226 grid
$w.validate.always_r
-columnspan 2 -sticky w
2227 grid columnconfigure
$w.validate
1 -weight 1
2228 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2230 set delete_branch_head
$current_branch
2231 set delete_branch_checktype
head
2233 bind $w <Visibility
> "grab $w; focus $w"
2234 bind $w <Key-Escape
> "destroy $w"
2235 wm title
$w "[appname] ([reponame]): Delete Branch"
2239 proc switch_branch
{new_branch
} {
2240 global HEAD commit_type current_branch repo_config
2242 if {![lock_index switch
]} return
2244 # -- Our in memory state should match the repository.
2246 repository_state curType curHEAD curMERGE_HEAD
2247 if {[string match amend
* $commit_type]
2248 && $curType eq
{normal
}
2249 && $curHEAD eq
$HEAD} {
2250 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2251 info_popup
{Last scanned state does not match repository state.
2253 Another Git program has modified this repository
2254 since the last scan. A rescan must be performed
2255 before the current branch can be changed.
2257 The rescan will be automatically started now.
2260 rescan
{set ui_status_value
{Ready.
}}
2264 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2265 switch_branch_stage2
{} $new_branch
2267 set ui_status_value
{Refreshing
file status...
}
2268 set cmd
[list git update-index
]
2270 lappend cmd
--unmerged
2271 lappend cmd
--ignore-missing
2272 lappend cmd
--refresh
2273 set fd_rf
[open
"| $cmd" r
]
2274 fconfigure
$fd_rf -blocking 0 -translation binary
2275 fileevent
$fd_rf readable \
2276 [list switch_branch_stage2
$fd_rf $new_branch]
2280 proc switch_branch_stage2
{fd_rf new_branch
} {
2281 global ui_status_value HEAD
2285 if {![eof
$fd_rf]} return
2289 set ui_status_value
"Updating working directory to '$new_branch'..."
2290 set cmd
[list git read-tree
]
2293 lappend cmd
--exclude-per-directory=.gitignore
2295 lappend cmd
$new_branch
2296 set fd_rt
[open
"| $cmd" r
]
2297 fconfigure
$fd_rt -blocking 0 -translation binary
2298 fileevent
$fd_rt readable \
2299 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2302 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2303 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2304 global current_branch
2305 global ui_comm ui_status_value
2307 # -- We never get interesting output on stdout; only stderr.
2310 fconfigure
$fd_rt -blocking 1
2311 if {![eof
$fd_rt]} {
2312 fconfigure
$fd_rt -blocking 0
2316 # -- The working directory wasn't in sync with the index and
2317 # we'd have to overwrite something to make the switch. A
2318 # merge is required.
2320 if {[catch
{close
$fd_rt} err
]} {
2321 regsub
{^fatal
: } $err {} err
2322 warn_popup
"File level merge required.
2326 Staying on branch '$current_branch'."
2327 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2332 # -- Update the symbolic ref. Core git doesn't even check for failure
2333 # here, it Just Works(tm). If it doesn't we are in some really ugly
2334 # state that is difficult to recover from within git-gui.
2336 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2337 error_popup
"Failed to set current branch.
2339 This working directory is only partially switched.
2340 We successfully updated your files, but failed to
2341 update an internal Git file.
2343 This should not have occurred. [appname] will now
2351 # -- Update our repository state. If we were previously in amend mode
2352 # we need to toss the current buffer and do a full rescan to update
2353 # our file lists. If we weren't in amend mode our file lists are
2354 # accurate and we can avoid the rescan.
2357 set selected_commit_type new
2358 if {[string match amend
* $commit_type]} {
2359 $ui_comm delete
0.0 end
2361 $ui_comm edit modified false
2362 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2364 repository_state commit_type HEAD MERGE_HEAD
2366 set ui_status_value
"Checked out branch '$current_branch'."
2370 ######################################################################
2372 ## remote management
2374 proc load_all_remotes
{} {
2376 global all_remotes tracking_branches
2378 set all_remotes
[list
]
2379 array
unset tracking_branches
2381 set rm_dir
[gitdir remotes
]
2382 if {[file isdirectory
$rm_dir]} {
2383 set all_remotes
[glob \
2387 -directory $rm_dir *]
2389 foreach name
$all_remotes {
2391 set fd
[open
[file join $rm_dir $name] r
]
2392 while {[gets
$fd line
] >= 0} {
2393 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2394 $line line src dst
]} continue
2395 if {![regexp ^refs
/ $dst]} {
2396 set dst
"refs/heads/$dst"
2398 set tracking_branches
($dst) [list
$name $src]
2405 foreach line
[array names repo_config remote.
*.url
] {
2406 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2407 lappend all_remotes
$name
2409 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2413 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2414 if {![regexp ^refs
/ $dst]} {
2415 set dst
"refs/heads/$dst"
2417 set tracking_branches
($dst) [list
$name $src]
2421 set all_remotes
[lsort
-unique $all_remotes]
2424 proc populate_fetch_menu
{m
} {
2425 global all_remotes repo_config
2427 foreach r
$all_remotes {
2429 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2430 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2435 set fd
[open
[gitdir remotes
$r] r
]
2436 while {[gets
$fd n
] >= 0} {
2437 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2448 -label "Fetch from $r..." \
2449 -command [list fetch_from
$r] \
2455 proc populate_push_menu
{m
} {
2456 global all_remotes repo_config
2458 foreach r
$all_remotes {
2460 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2461 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2466 set fd
[open
[gitdir remotes
$r] r
]
2467 while {[gets
$fd n
] >= 0} {
2468 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2479 -label "Push to $r..." \
2480 -command [list push_to
$r] \
2486 proc populate_pull_menu
{m
} {
2487 global repo_config all_remotes disable_on_lock
2489 foreach remote
$all_remotes {
2491 if {[array get repo_config remote.
$remote.url
] ne
{}} {
2492 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
2493 foreach line
$repo_config(remote.
$remote.fetch
) {
2494 if {[regexp
{^
([^
:]+):} $line line rb
]} {
2501 set fd
[open
[gitdir remotes
$remote] r
]
2502 while {[gets
$fd line
] >= 0} {
2503 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
2511 foreach rb
$rb_list {
2512 regsub ^refs
/heads
/ $rb {} rb_short
2514 -label "Branch $rb_short from $remote..." \
2515 -command [list pull_remote
$remote $rb] \
2517 lappend disable_on_lock \
2518 [list
$m entryconf
[$m index last
] -state]
2523 ######################################################################
2528 #define mask_width 14
2529 #define mask_height 15
2530 static unsigned char mask_bits
[] = {
2531 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2532 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2533 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2536 image create bitmap file_plain
-background white
-foreground black
-data {
2537 #define plain_width 14
2538 #define plain_height 15
2539 static unsigned char plain_bits
[] = {
2540 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2541 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2542 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2543 } -maskdata $filemask
2545 image create bitmap file_mod
-background white
-foreground blue
-data {
2546 #define mod_width 14
2547 #define mod_height 15
2548 static unsigned char mod_bits
[] = {
2549 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2550 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2551 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2552 } -maskdata $filemask
2554 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
2555 #define file_fulltick_width 14
2556 #define file_fulltick_height 15
2557 static unsigned char file_fulltick_bits
[] = {
2558 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2559 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2560 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2561 } -maskdata $filemask
2563 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
2564 #define parttick_width 14
2565 #define parttick_height 15
2566 static unsigned char parttick_bits
[] = {
2567 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2568 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2569 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2570 } -maskdata $filemask
2572 image create bitmap file_question
-background white
-foreground black
-data {
2573 #define file_question_width 14
2574 #define file_question_height 15
2575 static unsigned char file_question_bits
[] = {
2576 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2577 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2578 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2579 } -maskdata $filemask
2581 image create bitmap file_removed
-background white
-foreground red
-data {
2582 #define file_removed_width 14
2583 #define file_removed_height 15
2584 static unsigned char file_removed_bits
[] = {
2585 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2586 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2587 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2588 } -maskdata $filemask
2590 image create bitmap file_merge
-background white
-foreground blue
-data {
2591 #define file_merge_width 14
2592 #define file_merge_height 15
2593 static unsigned char file_merge_bits
[] = {
2594 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2595 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2596 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2597 } -maskdata $filemask
2599 set ui_index .vpane.files.index.list
2600 set ui_workdir .vpane.files.workdir.list
2602 set all_icons
(_
$ui_index) file_plain
2603 set all_icons
(A
$ui_index) file_fulltick
2604 set all_icons
(M
$ui_index) file_fulltick
2605 set all_icons
(D
$ui_index) file_removed
2606 set all_icons
(U
$ui_index) file_merge
2608 set all_icons
(_
$ui_workdir) file_plain
2609 set all_icons
(M
$ui_workdir) file_mod
2610 set all_icons
(D
$ui_workdir) file_question
2611 set all_icons
(U
$ui_workdir) file_merge
2612 set all_icons
(O
$ui_workdir) file_plain
2614 set max_status_desc
0
2618 {_M
"Modified, not staged"}
2619 {M_
"Staged for commit"}
2620 {MM
"Portions staged for commit"}
2621 {MD
"Staged for commit, missing"}
2623 {_O
"Untracked, not staged"}
2624 {A_
"Staged for commit"}
2625 {AM
"Portions staged for commit"}
2626 {AD
"Staged for commit, missing"}
2629 {D_
"Staged for removal"}
2630 {DO
"Staged for removal, still present"}
2632 {U_
"Requires merge resolution"}
2633 {UU
"Requires merge resolution"}
2634 {UM
"Requires merge resolution"}
2635 {UD
"Requires merge resolution"}
2637 if {$max_status_desc < [string length
[lindex
$i 1]]} {
2638 set max_status_desc
[string length
[lindex
$i 1]]
2640 set all_descs
([lindex
$i 0]) [lindex
$i 1]
2644 ######################################################################
2649 global tcl_platform tk_library
2650 if {[tk windowingsystem
] eq
{aqua
}} {
2656 proc is_Windows
{} {
2658 if {$tcl_platform(platform
) eq
{windows
}} {
2664 proc bind_button3
{w cmd
} {
2665 bind $w <Any-Button-3
> $cmd
2667 bind $w <Control-Button-1
> $cmd
2671 proc incr_font_size
{font
{amt
1}} {
2672 set sz
[font configure
$font -size]
2674 font configure
$font -size $sz
2675 font configure
${font}bold
-size $sz
2678 proc hook_failed_popup
{hook msg
} {
2683 label
$w.m.l1
-text "$hook hook failed:" \
2688 -background white
-borderwidth 1 \
2690 -width 80 -height 10 \
2692 -yscrollcommand [list
$w.m.sby
set]
2694 -text {You must correct the above errors before committing.
} \
2698 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2699 pack
$w.m.l1
-side top
-fill x
2700 pack
$w.m.l2
-side bottom
-fill x
2701 pack
$w.m.sby
-side right
-fill y
2702 pack
$w.m.t
-side left
-fill both
-expand 1
2703 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2705 $w.m.t insert
1.0 $msg
2706 $w.m.t conf
-state disabled
2708 button
$w.ok
-text OK \
2711 -command "destroy $w"
2712 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2714 bind $w <Visibility
> "grab $w; focus $w"
2715 bind $w <Key-Return
> "destroy $w"
2716 wm title
$w "[appname] ([reponame]): error"
2720 set next_console_id
0
2722 proc new_console
{short_title long_title
} {
2723 global next_console_id console_data
2724 set w .console
[incr next_console_id
]
2725 set console_data
($w) [list
$short_title $long_title]
2726 return [console_init
$w]
2729 proc console_init
{w
} {
2730 global console_cr console_data M1B
2732 set console_cr
($w) 1.0
2735 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2740 -background white
-borderwidth 1 \
2742 -width 80 -height 10 \
2745 -yscrollcommand [list
$w.m.sby
set]
2746 label
$w.m.s
-text {Working... please
wait...
} \
2750 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2751 pack
$w.m.l1
-side top
-fill x
2752 pack
$w.m.s
-side bottom
-fill x
2753 pack
$w.m.sby
-side right
-fill y
2754 pack
$w.m.t
-side left
-fill both
-expand 1
2755 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2757 menu
$w.ctxm
-tearoff 0
2758 $w.ctxm add
command -label "Copy" \
2760 -command "tk_textCopy $w.m.t"
2761 $w.ctxm add
command -label "Select All" \
2763 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2764 $w.ctxm add
command -label "Copy All" \
2767 $w.m.t tag add sel 0.0 end
2769 $w.m.t tag remove sel 0.0 end
2772 button
$w.ok
-text {Close
} \
2775 -command "destroy $w"
2776 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2778 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2779 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2780 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2781 bind $w <Visibility
> "focus $w"
2782 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2786 proc console_exec
{w cmd
{after
{}}} {
2787 # -- Windows tosses the enviroment when we exec our child.
2788 # But most users need that so we have to relogin. :-(
2791 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2794 # -- Tcl won't let us redirect both stdout and stderr to
2795 # the same pipe. So pass it through cat...
2797 set cmd
[concat |
$cmd |
& cat]
2799 set fd_f
[open
$cmd r
]
2800 fconfigure
$fd_f -blocking 0 -translation binary
2801 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2804 proc console_read
{w fd after
} {
2805 global console_cr console_data
2809 if {![winfo exists
$w]} {console_init
$w}
2810 $w.m.t conf
-state normal
2812 set n
[string length
$buf]
2814 set cr
[string first
"\r" $buf $c]
2815 set lf
[string first
"\n" $buf $c]
2816 if {$cr < 0} {set cr
[expr {$n + 1}]}
2817 if {$lf < 0} {set lf
[expr {$n + 1}]}
2820 $w.m.t insert end
[string range
$buf $c $lf]
2821 set console_cr
($w) [$w.m.t index
{end
-1c}]
2825 $w.m.t delete
$console_cr($w) end
2826 $w.m.t insert end
"\n"
2827 $w.m.t insert end
[string range
$buf $c $cr]
2832 $w.m.t conf
-state disabled
2836 fconfigure
$fd -blocking 1
2838 if {[catch
{close
$fd}]} {
2839 if {![winfo exists
$w]} {console_init
$w}
2840 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2841 $w.ok conf
-state normal
2843 } elseif
{[winfo exists
$w]} {
2844 $w.m.s conf
-background green
-text {Success
}
2845 $w.ok conf
-state normal
2848 array
unset console_cr
$w
2849 array
unset console_data
$w
2851 uplevel
#0 $after $ok
2855 fconfigure
$fd -blocking 0
2858 ######################################################################
2862 set starting_gitk_msg
{Starting gitk... please
wait...
}
2864 proc do_gitk
{revs
} {
2865 global ui_status_value starting_gitk_msg
2873 set cmd
"sh -c \"exec $cmd\""
2877 if {[catch
{eval exec $cmd} err
]} {
2878 error_popup
"Failed to start gitk:\n\n$err"
2880 set ui_status_value
$starting_gitk_msg
2882 if {$ui_status_value eq
$starting_gitk_msg} {
2883 set ui_status_value
{Ready.
}
2890 set fd
[open
"| git count-objects -v" r
]
2891 while {[gets
$fd line
] > 0} {
2892 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
2893 set stats
($name) $value
2899 foreach p
[glob
-directory [gitdir objects pack
] \
2902 incr packed_sz
[file size
$p]
2904 if {$packed_sz > 0} {
2905 set stats
(size-pack
) [expr {$packed_sz / 1024}]
2910 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2912 label
$w.header
-text {Database Statistics
} \
2914 pack
$w.header
-side top
-fill x
2916 frame
$w.buttons
-border 1
2917 button
$w.buttons.close
-text Close \
2919 -command [list destroy
$w]
2920 button
$w.buttons.gc
-text {Compress Database
} \
2922 -command "destroy $w;do_gc"
2923 pack
$w.buttons.close
-side right
2924 pack
$w.buttons.gc
-side left
2925 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2927 frame
$w.stat
-borderwidth 1 -relief solid
2929 {count
{Number of loose objects
}}
2930 {size
{Disk space used by loose objects
} { KiB
}}
2931 {in-pack
{Number of packed objects
}}
2932 {packs
{Number of packs
}}
2933 {size-pack
{Disk space used by packed objects
} { KiB
}}
2934 {prune-packable
{Packed objects waiting
for pruning
}}
2935 {garbage
{Garbage files
}}
2937 set name
[lindex
$s 0]
2938 set label
[lindex
$s 1]
2939 if {[catch
{set value
$stats($name)}]} continue
2940 if {[llength
$s] > 2} {
2941 set value
"$value[lindex $s 2]"
2944 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
2945 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
2946 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
2950 bind $w <Visibility
> "grab $w; focus $w"
2951 bind $w <Key-Escape
> [list destroy
$w]
2952 bind $w <Key-Return
> [list destroy
$w]
2953 wm title
$w "[appname] ([reponame]): Database Statistics"
2958 set w
[new_console
{gc
} {Compressing the object database
}]
2959 console_exec
$w {git gc
}
2962 proc do_fsck_objects
{} {
2963 set w
[new_console
{fsck-objects
} \
2964 {Verifying the object database with fsck-objects
}]
2965 set cmd
[list git fsck-objects
]
2968 lappend cmd
--strict
2969 console_exec
$w $cmd
2975 global ui_comm is_quitting repo_config commit_type
2977 if {$is_quitting} return
2980 # -- Stash our current commit buffer.
2982 set save
[gitdir GITGUI_MSG
]
2983 set msg
[string trim
[$ui_comm get
0.0 end
]]
2984 if {![string match amend
* $commit_type]
2985 && [$ui_comm edit modified
]
2988 set fd
[open
$save w
]
2989 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2993 catch
{file delete
$save}
2996 # -- Stash our current window geometry into this repository.
2998 set cfg_geometry
[list
]
2999 lappend cfg_geometry
[wm geometry .
]
3000 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
3001 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
3002 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
3005 if {$cfg_geometry ne
$rc_geometry} {
3006 catch
{exec git repo-config gui.geometry
$cfg_geometry}
3013 rescan
{set ui_status_value
{Ready.
}}
3016 proc unstage_helper
{txt paths
} {
3017 global file_states current_diff_path
3019 if {![lock_index begin-update
]} return
3023 foreach path
$paths {
3024 switch
-glob -- [lindex
$file_states($path) 0] {
3028 lappend pathList
$path
3029 if {$path eq
$current_diff_path} {
3030 set after
{reshow_diff
;}
3035 if {$pathList eq
{}} {
3041 [concat
$after {set ui_status_value
{Ready.
}}]
3045 proc do_unstage_selection
{} {
3046 global current_diff_path selected_paths
3048 if {[array size selected_paths
] > 0} {
3050 {Unstaging selected files from commit
} \
3051 [array names selected_paths
]
3052 } elseif
{$current_diff_path ne
{}} {
3054 "Unstaging [short_path $current_diff_path] from commit" \
3055 [list
$current_diff_path]
3059 proc add_helper
{txt paths
} {
3060 global file_states current_diff_path
3062 if {![lock_index begin-update
]} return
3066 foreach path
$paths {
3067 switch
-glob -- [lindex
$file_states($path) 0] {
3072 lappend pathList
$path
3073 if {$path eq
$current_diff_path} {
3074 set after
{reshow_diff
;}
3079 if {$pathList eq
{}} {
3085 [concat
$after {set ui_status_value
{Ready to commit.
}}]
3089 proc do_add_selection
{} {
3090 global current_diff_path selected_paths
3092 if {[array size selected_paths
] > 0} {
3094 {Adding selected files
} \
3095 [array names selected_paths
]
3096 } elseif
{$current_diff_path ne
{}} {
3098 "Adding [short_path $current_diff_path]" \
3099 [list
$current_diff_path]
3103 proc do_add_all
{} {
3107 foreach path
[array names file_states
] {
3108 switch
-glob -- [lindex
$file_states($path) 0] {
3111 ?D
{lappend paths
$path}
3114 add_helper
{Adding all changed files
} $paths
3117 proc revert_helper
{txt paths
} {
3118 global file_states current_diff_path
3120 if {![lock_index begin-update
]} return
3124 foreach path
$paths {
3125 switch
-glob -- [lindex
$file_states($path) 0] {
3129 lappend pathList
$path
3130 if {$path eq
$current_diff_path} {
3131 set after
{reshow_diff
;}
3137 set n
[llength
$pathList]
3141 } elseif
{$n == 1} {
3142 set s
"[short_path [lindex $pathList]]"
3144 set s
"these $n files"
3147 set reply
[tk_dialog \
3149 "[appname] ([reponame])" \
3150 "Revert changes in $s?
3152 Any unadded changes will be permanently lost by the revert." \
3162 [concat
$after {set ui_status_value
{Ready.
}}]
3168 proc do_revert_selection
{} {
3169 global current_diff_path selected_paths
3171 if {[array size selected_paths
] > 0} {
3173 {Reverting selected files
} \
3174 [array names selected_paths
]
3175 } elseif
{$current_diff_path ne
{}} {
3177 "Reverting [short_path $current_diff_path]" \
3178 [list
$current_diff_path]
3182 proc do_signoff
{} {
3185 set me
[committer_ident
]
3186 if {$me eq
{}} return
3188 set sob
"Signed-off-by: $me"
3189 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
3190 if {$last ne
$sob} {
3191 $ui_comm edit separator
3193 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
3194 $ui_comm insert end
"\n"
3196 $ui_comm insert end
"\n$sob"
3197 $ui_comm edit separator
3202 proc do_select_commit_type
{} {
3203 global commit_type selected_commit_type
3205 if {$selected_commit_type eq
{new
}
3206 && [string match amend
* $commit_type]} {
3208 } elseif
{$selected_commit_type eq
{amend
}
3209 && ![string match amend
* $commit_type]} {
3212 # The amend request was rejected...
3214 if {![string match amend
* $commit_type]} {
3215 set selected_commit_type new
3225 global appvers copyright
3226 global tcl_patchLevel tk_patchLevel
3230 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3232 label
$w.header
-text "About [appname]" \
3234 pack
$w.header
-side top
-fill x
3237 button
$w.buttons.close
-text {Close
} \
3239 -command [list destroy
$w]
3240 pack
$w.buttons.close
-side right
3241 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3244 -text "[appname] - a commit creation tool for Git.
3252 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
3255 append v
"[appname] version $appvers\n"
3256 append v
"[exec git version]\n"
3258 if {$tcl_patchLevel eq
$tk_patchLevel} {
3259 append v
"Tcl/Tk version $tcl_patchLevel"
3261 append v
"Tcl version $tcl_patchLevel"
3262 append v
", Tk version $tk_patchLevel"
3273 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
3275 menu
$w.ctxm
-tearoff 0
3276 $w.ctxm add
command \
3281 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3284 bind $w <Visibility
> "grab $w; focus $w"
3285 bind $w <Key-Escape
> "destroy $w"
3286 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3287 wm title
$w "About [appname]"
3291 proc do_options
{} {
3292 global repo_config global_config font_descs
3293 global repo_config_new global_config_new
3295 array
unset repo_config_new
3296 array
unset global_config_new
3297 foreach name
[array names repo_config
] {
3298 set repo_config_new
($name) $repo_config($name)
3301 foreach name
[array names repo_config
] {
3303 gui.diffcontext
{continue}
3305 set repo_config_new
($name) $repo_config($name)
3307 foreach name
[array names global_config
] {
3308 set global_config_new
($name) $global_config($name)
3311 set w .options_editor
3313 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3315 label
$w.header
-text "[appname] Options" \
3317 pack
$w.header
-side top
-fill x
3320 button
$w.buttons.restore
-text {Restore Defaults
} \
3322 -command do_restore_defaults
3323 pack
$w.buttons.restore
-side left
3324 button
$w.buttons.save
-text Save \
3327 catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3330 pack
$w.buttons.save
-side right
3331 button
$w.buttons.cancel
-text {Cancel
} \
3333 -command [list destroy
$w]
3334 pack
$w.buttons.cancel
-side right
-padx 5
3335 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3337 labelframe
$w.repo
-text "[reponame] Repository" \
3339 labelframe
$w.global
-text {Global
(All Repositories
)} \
3341 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
3342 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
3345 {b pullsummary
{Show Pull Summary
}}
3346 {b trustmtime
{Trust File Modification Timestamps
}}
3347 {i diffcontext
{Number of Diff Context Lines
}}
3348 {t newbranchtemplate
{New Branch Name Template
}}
3350 set type [lindex
$option 0]
3351 set name
[lindex
$option 1]
3352 set text
[lindex
$option 2]
3353 foreach f
{repo global
} {
3356 checkbutton
$w.
$f.
$name -text $text \
3357 -variable ${f}_config_new
(gui.
$name) \
3361 pack
$w.
$f.
$name -side top
-anchor w
3365 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3366 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
3367 spinbox
$w.
$f.
$name.v \
3368 -textvariable ${f}_config_new
(gui.
$name) \
3369 -from 1 -to 99 -increment 1 \
3372 bind $w.
$f.
$name.v
<FocusIn
> {%W selection range
0 end
}
3373 pack
$w.
$f.
$name.v
-side right
-anchor e
-padx 5
3374 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3378 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3379 text
$w.
$f.
$name.v \
3385 $w.
$f.
$name.v insert
0.0 [set ${f}_config_new
(gui.
$name)]
3386 bind $w.
$f.
$name.v
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
3387 bind $w.
$f.
$name.v
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
3388 bind $w.
$f.
$name.v
<Key-Return
> break
3389 bind $w.
$f.
$name.v
<FocusIn
> "$w.$f.$name.v tag add sel 0.0 end"
3390 bind $w.
$f.
$name.v
<FocusOut
> "
3391 set ${f}_config_new(gui.$name) \
3392 \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3394 pack
$w.
$f.
$name.l
-side left
-anchor w
3395 pack
$w.
$f.
$name.v
-side left
-anchor w \
3398 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3404 set all_fonts
[lsort
[font families
]]
3405 foreach option
$font_descs {
3406 set name
[lindex
$option 0]
3407 set font
[lindex
$option 1]
3408 set text
[lindex
$option 2]
3410 set global_config_new
(gui.
$font^^family
) \
3411 [font configure
$font -family]
3412 set global_config_new
(gui.
$font^^size
) \
3413 [font configure
$font -size]
3415 frame
$w.global.
$name
3416 label
$w.global.
$name.l
-text "$text:" -font font_ui
3417 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
3418 eval tk_optionMenu
$w.global.
$name.family \
3419 global_config_new
(gui.
$font^^family
) \
3421 spinbox
$w.global.
$name.size \
3422 -textvariable global_config_new
(gui.
$font^^size
) \
3423 -from 2 -to 80 -increment 1 \
3426 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
3427 pack
$w.global.
$name.size
-side right
-anchor e
3428 pack
$w.global.
$name.family
-side right
-anchor e
3429 pack
$w.global.
$name -side top
-anchor w
-fill x
3432 bind $w <Visibility
> "grab $w; focus $w"
3433 bind $w <Key-Escape
> "destroy $w"
3434 wm title
$w "[appname] ([reponame]): Options"
3438 proc do_restore_defaults
{} {
3439 global font_descs default_config repo_config
3440 global repo_config_new global_config_new
3442 foreach name
[array names default_config
] {
3443 set repo_config_new
($name) $default_config($name)
3444 set global_config_new
($name) $default_config($name)
3447 foreach option
$font_descs {
3448 set name
[lindex
$option 0]
3449 set repo_config
(gui.
$name) $default_config(gui.
$name)
3453 foreach option
$font_descs {
3454 set name
[lindex
$option 0]
3455 set font
[lindex
$option 1]
3456 set global_config_new
(gui.
$font^^family
) \
3457 [font configure
$font -family]
3458 set global_config_new
(gui.
$font^^size
) \
3459 [font configure
$font -size]
3463 proc do_save_config
{w
} {
3464 if {[catch
{save_config
} err
]} {
3465 error_popup
"Failed to completely save options:\n\n$err"
3471 proc do_windows_shortcut
{} {
3475 set desktop
[exec cygpath \
3483 set fn
[tk_getSaveFile \
3485 -title "[appname] ([reponame]): Create Desktop Icon" \
3486 -initialdir $desktop \
3487 -initialfile "Git [reponame].bat"]
3491 set sh
[exec cygpath \
3495 set me
[exec cygpath \
3499 set gd
[exec cygpath \
3503 set gw
[exec cygpath \
3506 [file dirname [gitdir
]]]
3507 regsub
-all ' $me "'\\''" me
3508 regsub -all ' $gd "'\\''" gd
3509 puts $fd "@ECHO Entering $gw"
3510 puts $fd "@ECHO Starting git-gui... please wait..."
3511 puts -nonewline $fd "@\"$sh\" --login -c \""
3512 puts -nonewline $fd "GIT_DIR='$gd'"
3513 puts -nonewline $fd " '$me'"
3517 error_popup "Cannot write script:\n\n$err"
3522 proc do_macosx_app {} {
3525 set fn [tk_getSaveFile \
3527 -title "[appname] ([reponame]): Create Desktop Icon" \
3528 -initialdir [file join $env(HOME) Desktop] \
3529 -initialfile "Git [reponame].app"]
3532 set Contents [file join $fn Contents]
3533 set MacOS [file join $Contents MacOS]
3534 set exe [file join $MacOS git-gui]
3538 set fd [open [file join $Contents Info.plist] w]
3539 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3540 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3541 <plist version="1.0">
3543 <key>CFBundleDevelopmentRegion</key>
3544 <string>English</string>
3545 <key>CFBundleExecutable</key>
3546 <string>git-gui</string>
3547 <key>CFBundleIdentifier</key>
3548 <string>org.spearce.git-gui</string>
3549 <key>CFBundleInfoDictionaryVersion</key>
3550 <string>6.0</string>
3551 <key>CFBundlePackageType</key>
3552 <string>APPL</string>
3553 <key>CFBundleSignature</key>
3554 <string>????</string>
3555 <key>CFBundleVersion</key>
3556 <string>1.0</string>
3557 <key>NSPrincipalClass</key>
3558 <string>NSApplication</string>
3563 set fd [open $exe w]
3564 set gd [file normalize [gitdir]]
3565 set ep [file normalize [exec git --exec-path]]
3566 regsub -all ' $gd "'\\''" gd
3567 regsub
-all ' $ep "'\\''" ep
3568 puts $fd "#!/bin/sh"
3569 foreach name
[array names env
] {
3570 if {[string match GIT_
* $name]} {
3571 regsub
-all ' $env($name) "'\\''" v
3572 puts $fd "export $name='$v'"
3575 puts $fd "export PATH
='$ep':\
$PATH"
3576 puts $fd "export GIT_DIR
='$gd'"
3577 puts $fd "exec [file normalize
$argv0]"
3580 file attributes $exe -permissions u+x,g+x,o+x
3582 error_popup "Cannot
write icon
:\n\n$err"
3587 proc toggle_or_diff {w x y} {
3588 global file_states file_lists current_diff_path ui_index ui_workdir
3589 global last_clicked selected_paths
3591 set pos [split [$w index @$x,$y] .]
3592 set lno [lindex $pos 0]
3593 set col [lindex $pos 1]
3594 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3600 set last_clicked [list $w $lno]
3601 array unset selected_paths
3602 $ui_index tag remove in_sel 0.0 end
3603 $ui_workdir tag remove in_sel 0.0 end
3606 if {$current_diff_path eq $path} {
3607 set after {reshow_diff;}
3611 if {$w eq $ui_index} {
3613 "Unstaging
[short_path
$path] from commit
" \
3615 [concat $after {set ui_status_value {Ready.}}]
3616 } elseif {$w eq $ui_workdir} {
3618 "Adding
[short_path
$path]" \
3620 [concat $after {set ui_status_value {Ready.}}]
3623 show_diff $path $w $lno
3627 proc add_one_to_selection {w x y} {
3628 global file_lists last_clicked selected_paths
3630 set lno [lindex [split [$w index @$x,$y] .] 0]
3631 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3637 if {$last_clicked ne {}
3638 && [lindex $last_clicked 0] ne $w} {
3639 array unset selected_paths
3640 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3643 set last_clicked [list $w $lno]
3644 if {[catch {set in_sel $selected_paths($path)}]} {
3648 unset selected_paths($path)
3649 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3651 set selected_paths($path) 1
3652 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3656 proc add_range_to_selection {w x y} {
3657 global file_lists last_clicked selected_paths
3659 if {[lindex $last_clicked 0] ne $w} {
3660 toggle_or_diff $w $x $y
3664 set lno [lindex [split [$w index @$x,$y] .] 0]
3665 set lc [lindex $last_clicked 1]
3674 foreach path [lrange $file_lists($w) \
3675 [expr {$begin - 1}] \
3676 [expr {$end - 1}]] {
3677 set selected_paths($path) 1
3679 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3682 ######################################################################
3686 set cursor_ptr arrow
3687 font create font_diff -family Courier -size 10
3691 eval font configure font_ui [font actual [.dummy cget -font]]
3695 font create font_uibold
3696 font create font_diffbold
3701 } elseif {[is_MacOSX]} {
3709 proc apply_config {} {
3710 global repo_config font_descs
3712 foreach option $font_descs {
3713 set name [lindex $option 0]
3714 set font [lindex $option 1]
3716 foreach {cn cv} $repo_config(gui.$name) {
3717 font configure $font $cn $cv
3720 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
3722 foreach {cn cv} [font configure $font] {
3723 font configure ${font}bold $cn $cv
3725 font configure ${font}bold -weight bold
3729 set default_config(gui.trustmtime) false
3730 set default_config(gui.pullsummary) true
3731 set default_config(gui.diffcontext) 5
3732 set default_config(gui.newbranchtemplate) {}
3733 set default_config(gui.fontui) [font configure font_ui]
3734 set default_config(gui.fontdiff) [font configure font_diff]
3736 {fontui font_ui {Main Font}}
3737 {fontdiff font_diff {Diff/Console Font}}
3742 ######################################################################
3748 menu .mbar -tearoff 0
3749 .mbar add cascade -label Repository -menu .mbar.repository
3750 .mbar add cascade -label Edit -menu .mbar.edit
3751 if {!$single_commit} {
3752 .mbar add cascade -label Branch -menu .mbar.branch
3754 .mbar add cascade -label Commit -menu .mbar.commit
3755 if {!$single_commit} {
3756 .mbar add cascade -label Fetch -menu .mbar.fetch
3757 .mbar add cascade -label Pull -menu .mbar.pull
3758 .mbar add cascade -label Push -menu .mbar.push
3760 . configure -menu .mbar
3762 # -- Repository Menu
3764 menu .mbar.repository
3765 .mbar.repository add command \
3766 -label {Visualize Current Branch} \
3767 -command {do_gitk {}} \
3770 .mbar.repository add command \
3771 -label {Visualize All Branches} \
3772 -command {do_gitk {--all}} \
3775 .mbar.repository add separator
3777 if {!$single_commit} {
3778 .mbar.repository add command -label {Database Statistics} \
3782 .mbar.repository add command -label {Compress Database} \
3786 .mbar.repository add command -label {Verify Database} \
3787 -command do_fsck_objects \
3790 .mbar.repository add separator
3793 .mbar.repository add command \
3794 -label {Create Desktop Icon} \
3795 -command do_windows_shortcut \
3797 } elseif {[is_MacOSX]} {
3798 .mbar.repository add command \
3799 -label {Create Desktop Icon} \
3800 -command do_macosx_app \
3805 .mbar.repository add command -label Quit \
3807 -accelerator $M1T-Q \
3813 .mbar.edit add command -label Undo \
3814 -command {catch {[focus] edit undo}} \
3815 -accelerator $M1T-Z \
3817 .mbar.edit add command -label Redo \
3818 -command {catch {[focus] edit redo}} \
3819 -accelerator $M1T-Y \
3821 .mbar.edit add separator
3822 .mbar.edit add command -label Cut \
3823 -command {catch {tk_textCut [focus]}} \
3824 -accelerator $M1T-X \
3826 .mbar.edit add command -label Copy \
3827 -command {catch {tk_textCopy [focus]}} \
3828 -accelerator $M1T-C \
3830 .mbar.edit add command -label Paste \
3831 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3832 -accelerator $M1T-V \
3834 .mbar.edit add command -label Delete \
3835 -command {catch {[focus] delete sel.first sel.last}} \
3838 .mbar.edit add separator
3839 .mbar.edit add command -label {Select All} \
3840 -command {catch {[focus] tag add sel 0.0 end}} \
3841 -accelerator $M1T-A \
3846 if {!$single_commit} {
3849 .mbar.branch add command -label {Create...} \
3850 -command do_create_branch \
3851 -accelerator $M1T-N \
3853 lappend disable_on_lock [list .mbar.branch entryconf \
3854 [.mbar.branch index last] -state]
3856 .mbar.branch add command -label {Delete...} \
3857 -command do_delete_branch \
3859 lappend disable_on_lock [list .mbar.branch entryconf \
3860 [.mbar.branch index last] -state]
3867 .mbar.commit add radiobutton \
3868 -label {New Commit} \
3869 -command do_select_commit_type \
3870 -variable selected_commit_type \
3873 lappend disable_on_lock \
3874 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3876 .mbar.commit add radiobutton \
3877 -label {Amend Last Commit} \
3878 -command do_select_commit_type \
3879 -variable selected_commit_type \
3882 lappend disable_on_lock \
3883 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3885 .mbar.commit add separator
3887 .mbar.commit add command -label Rescan \
3888 -command do_rescan \
3891 lappend disable_on_lock \
3892 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3894 .mbar.commit add command -label {Add To Commit} \
3895 -command do_add_selection \
3897 lappend disable_on_lock \
3898 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3900 .mbar.commit add command -label {Add All To Commit} \
3901 -command do_add_all \
3902 -accelerator $M1T-I \
3904 lappend disable_on_lock \
3905 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3907 .mbar.commit add command -label {Unstage From Commit} \
3908 -command do_unstage_selection \
3910 lappend disable_on_lock \
3911 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3913 .mbar.commit add command -label {Revert Changes} \
3914 -command do_revert_selection \
3916 lappend disable_on_lock \
3917 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3919 .mbar.commit add separator
3921 .mbar.commit add command -label {Sign Off} \
3922 -command do_signoff \
3923 -accelerator $M1T-S \
3926 .mbar.commit add command -label Commit \
3927 -command do_commit \
3928 -accelerator $M1T-Return \
3930 lappend disable_on_lock \
3931 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3933 # -- Transport menus
3935 if {!$single_commit} {
3942 # -- Apple Menu (Mac OS X only)
3944 .mbar add cascade -label Apple -menu .mbar.apple
3947 .mbar.apple add command -label "About
[appname
]" \
3950 .mbar.apple add command -label "[appname
] Options...
" \
3951 -command do_options \
3956 .mbar.edit add separator
3957 .mbar.edit add command -label {Options...} \
3958 -command do_options \
3963 if {[file exists /usr/local/miga/lib/gui-miga]
3964 && [file exists .pvcsrc]} {
3966 global ui_status_value
3967 if {![lock_index update]} return
3968 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3969 set miga_fd [open "|
$cmd" r]
3970 fconfigure $miga_fd -blocking 0
3971 fileevent $miga_fd readable [list miga_done $miga_fd]
3972 set ui_status_value {Running miga...}
3974 proc miga_done {fd} {
3979 rescan [list set ui_status_value {Ready.}]
3982 .mbar add cascade -label Tools -menu .mbar.tools
3984 .mbar.tools add command -label "Migrate
" \
3987 lappend disable_on_lock \
3988 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3993 .mbar add cascade -label Help -menu .mbar.help
3996 .mbar.help add command -label "About
[appname
]" \
4008 -text {Current Branch:} \
4013 -textvariable current_branch \
4017 pack .branch.l1 -side left
4018 pack .branch.cb -side left -fill x
4019 pack .branch -side top -fill x
4021 # -- Main Window Layout
4023 panedwindow .vpane -orient vertical
4024 panedwindow .vpane.files -orient horizontal
4025 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4026 pack .vpane -anchor n -side top -fill both -expand 1
4028 # -- Index File List
4030 frame .vpane.files.index -height 100 -width 200
4031 label .vpane.files.index.title -text {Changes To Be Committed} \
4034 text $ui_index -background white -borderwidth 0 \
4035 -width 20 -height 10 \
4038 -cursor $cursor_ptr \
4039 -xscrollcommand {.vpane.files.index.sx set} \
4040 -yscrollcommand {.vpane.files.index.sy set} \
4042 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4043 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4044 pack .vpane.files.index.title -side top -fill x
4045 pack .vpane.files.index.sx -side bottom -fill x
4046 pack .vpane.files.index.sy -side right -fill y
4047 pack $ui_index -side left -fill both -expand 1
4048 .vpane.files add .vpane.files.index -sticky nsew
4050 # -- Working Directory File List
4052 frame .vpane.files.workdir -height 100 -width 200
4053 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4056 text $ui_workdir -background white -borderwidth 0 \
4057 -width 20 -height 10 \
4060 -cursor $cursor_ptr \
4061 -xscrollcommand {.vpane.files.workdir.sx set} \
4062 -yscrollcommand {.vpane.files.workdir.sy set} \
4064 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4065 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4066 pack .vpane.files.workdir.title -side top -fill x
4067 pack .vpane.files.workdir.sx -side bottom -fill x
4068 pack .vpane.files.workdir.sy -side right -fill y
4069 pack $ui_workdir -side left -fill both -expand 1
4070 .vpane.files add .vpane.files.workdir -sticky nsew
4072 foreach i [list $ui_index $ui_workdir] {
4073 $i tag conf in_diff -font font_uibold
4074 $i tag conf in_sel \
4075 -background [$i cget -foreground] \
4076 -foreground [$i cget -background]
4080 # -- Diff and Commit Area
4082 frame .vpane.lower -height 300 -width 400
4083 frame .vpane.lower.commarea
4084 frame .vpane.lower.diff -relief sunken -borderwidth 1
4085 pack .vpane.lower.commarea -side top -fill x
4086 pack .vpane.lower.diff -side bottom -fill both -expand 1
4087 .vpane add .vpane.lower -sticky nsew
4089 # -- Commit Area Buttons
4091 frame .vpane.lower.commarea.buttons
4092 label .vpane.lower.commarea.buttons.l -text {} \
4096 pack .vpane.lower.commarea.buttons.l -side top -fill x
4097 pack .vpane.lower.commarea.buttons -side left -fill y
4099 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4100 -command do_rescan \
4102 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4103 lappend disable_on_lock \
4104 {.vpane.lower.commarea.buttons.rescan conf -state}
4106 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4107 -command do_add_all \
4109 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4110 lappend disable_on_lock \
4111 {.vpane.lower.commarea.buttons.incall conf -state}
4113 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4114 -command do_signoff \
4116 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4118 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4119 -command do_commit \
4121 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4122 lappend disable_on_lock \
4123 {.vpane.lower.commarea.buttons.commit conf -state}
4125 # -- Commit Message Buffer
4127 frame .vpane.lower.commarea.buffer
4128 frame .vpane.lower.commarea.buffer.header
4129 set ui_comm .vpane.lower.commarea.buffer.t
4130 set ui_coml .vpane.lower.commarea.buffer.header.l
4131 radiobutton .vpane.lower.commarea.buffer.header.new \
4132 -text {New Commit} \
4133 -command do_select_commit_type \
4134 -variable selected_commit_type \
4137 lappend disable_on_lock \
4138 [list .vpane.lower.commarea.buffer.header.new conf -state]
4139 radiobutton .vpane.lower.commarea.buffer.header.amend \
4140 -text {Amend Last Commit} \
4141 -command do_select_commit_type \
4142 -variable selected_commit_type \
4145 lappend disable_on_lock \
4146 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4151 proc trace_commit_type {varname args} {
4152 global ui_coml commit_type
4153 switch -glob -- $commit_type {
4154 initial {set txt {Initial Commit Message:}}
4155 amend {set txt {Amended Commit Message:}}
4156 amend-initial {set txt {Amended Initial Commit Message:}}
4157 amend-merge {set txt {Amended Merge Commit Message:}}
4158 merge {set txt {Merge Commit Message:}}
4159 * {set txt {Commit Message:}}
4161 $ui_coml conf -text $txt
4163 trace add variable commit_type write trace_commit_type
4164 pack $ui_coml -side left -fill x
4165 pack .vpane.lower.commarea.buffer.header.amend -side right
4166 pack .vpane.lower.commarea.buffer.header.new -side right
4168 text $ui_comm -background white -borderwidth 1 \
4171 -autoseparators true \
4173 -width 75 -height 9 -wrap none \
4175 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4176 scrollbar .vpane.lower.commarea.buffer.sby \
4177 -command [list $ui_comm yview]
4178 pack .vpane.lower.commarea.buffer.header -side top -fill x
4179 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4180 pack $ui_comm -side left -fill y
4181 pack .vpane.lower.commarea.buffer -side left -fill y
4183 # -- Commit Message Buffer Context Menu
4185 set ctxm .vpane.lower.commarea.buffer.ctxm
4186 menu $ctxm -tearoff 0
4190 -command {tk_textCut $ui_comm}
4194 -command {tk_textCopy $ui_comm}
4198 -command {tk_textPaste $ui_comm}
4202 -command {$ui_comm delete sel.first sel.last}
4205 -label {Select All} \
4207 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4212 $ui_comm tag add sel 0.0 end
4213 tk_textCopy $ui_comm
4214 $ui_comm tag remove sel 0.0 end
4221 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
4225 set current_diff_path {}
4226 set current_diff_side {}
4227 set diff_actions [list]
4228 proc trace_current_diff_path {varname args} {
4229 global current_diff_path diff_actions file_states
4230 if {$current_diff_path eq {}} {
4236 set p $current_diff_path
4237 set s [mapdesc [lindex $file_states($p) 0] $p]
4239 set p [escape_path $p]
4243 .vpane.lower.diff.header.status configure -text $s
4244 .vpane.lower.diff.header.file configure -text $f
4245 .vpane.lower.diff.header.path configure -text $p
4246 foreach w $diff_actions {
4250 trace add variable current_diff_path write trace_current_diff_path
4252 frame .vpane.lower.diff.header -background orange
4253 label .vpane.lower.diff.header.status \
4254 -background orange \
4255 -width $max_status_desc \
4259 label .vpane.lower.diff.header.file \
4260 -background orange \
4264 label .vpane.lower.diff.header.path \
4265 -background orange \
4269 pack .vpane.lower.diff.header.status -side left
4270 pack .vpane.lower.diff.header.file -side left
4271 pack .vpane.lower.diff.header.path -fill x
4272 set ctxm .vpane.lower.diff.header.ctxm
4273 menu $ctxm -tearoff 0
4282 -- $current_diff_path
4284 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4285 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
4289 frame .vpane.lower.diff.body
4290 set ui_diff .vpane.lower.diff.body.t
4291 text $ui_diff -background white -borderwidth 0 \
4292 -width 80 -height 15 -wrap none \
4294 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4295 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4297 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4298 -command [list $ui_diff xview]
4299 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4300 -command [list $ui_diff yview]
4301 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4302 pack .vpane.lower.diff.body.sby -side right -fill y
4303 pack $ui_diff -side left -fill both -expand 1
4304 pack .vpane.lower.diff.header -side top -fill x
4305 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4307 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4308 $ui_diff tag conf d_+ -foreground {#00a000}
4309 $ui_diff tag conf d_- -foreground red
4311 $ui_diff tag conf d_++ -foreground {#00a000}
4312 $ui_diff tag conf d_-- -foreground red
4313 $ui_diff tag conf d_+s \
4314 -foreground {#00a000} \
4315 -background {#e2effa}
4316 $ui_diff tag conf d_-s \
4318 -background {#e2effa}
4319 $ui_diff tag conf d_s+ \
4320 -foreground {#00a000} \
4322 $ui_diff tag conf d_s- \
4326 $ui_diff tag conf d<<<<<<< \
4327 -foreground orange \
4329 $ui_diff tag conf d======= \
4330 -foreground orange \
4332 $ui_diff tag conf d>>>>>>> \
4333 -foreground orange \
4336 $ui_diff tag raise sel
4338 # -- Diff Body Context Menu
4340 set ctxm .vpane.lower.diff.body.ctxm
4341 menu $ctxm -tearoff 0
4345 -command reshow_diff
4346 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4350 -command {tk_textCopy $ui_diff}
4351 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4353 -label {Select All} \
4355 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4356 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4361 $ui_diff tag add sel 0.0 end
4362 tk_textCopy $ui_diff
4363 $ui_diff tag remove sel 0.0 end
4365 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4368 -label {Apply/Reverse Hunk} \
4370 -command {apply_hunk $cursorX $cursorY}
4371 set ui_diff_applyhunk [$ctxm index last]
4372 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4375 -label {Decrease Font Size} \
4377 -command {incr_font_size font_diff -1}
4378 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4380 -label {Increase Font Size} \
4382 -command {incr_font_size font_diff 1}
4383 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4386 -label {Show Less Context} \
4388 -command {if {$repo_config(gui.diffcontext) >= 2} {
4389 incr repo_config(gui.diffcontext) -1
4392 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4394 -label {Show More Context} \
4397 incr repo_config(gui.diffcontext)
4400 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4402 $ctxm add command -label {Options...} \
4405 bind_button3 $ui_diff "
4408 if {\
$ui_index eq \
$current_diff_side} {
4409 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
4411 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
4413 tk_popup
$ctxm %X
%Y
4418 set ui_status_value {Initializing...}
4419 label .status -textvariable ui_status_value \
4425 pack .status -anchor w -side bottom -fill x
4430 set gm $repo_config(gui.geometry)
4431 wm geometry . [lindex $gm 0]
4432 .vpane sash place 0 \
4433 [lindex [.vpane sash coord 0] 0] \
4435 .vpane.files sash place 0 \
4437 [lindex [.vpane.files sash coord 0] 1]
4443 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4444 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4445 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4446 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4447 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4448 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4449 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4450 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4451 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4452 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4453 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4455 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4456 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4457 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4458 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4459 bind $ui_diff <$M1B-Key-v> {break}
4460 bind $ui_diff <$M1B-Key-V> {break}
4461 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4462 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4463 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4464 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4465 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4466 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4468 if {!$single_commit} {
4469 bind . <$M1B-Key-n> do_create_branch
4470 bind . <$M1B-Key-N> do_create_branch
4473 bind . <Destroy> do_quit
4474 bind all <Key-F5> do_rescan
4475 bind all <$M1B-Key-r> do_rescan
4476 bind all <$M1B-Key-R> do_rescan
4477 bind . <$M1B-Key-s> do_signoff
4478 bind . <$M1B-Key-S> do_signoff
4479 bind . <$M1B-Key-i> do_add_all
4480 bind . <$M1B-Key-I> do_add_all
4481 bind . <$M1B-Key-Return> do_commit
4482 bind all <$M1B-Key-q> do_quit
4483 bind all <$M1B-Key-Q> do_quit
4484 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4485 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4486 foreach i [list $ui_index $ui_workdir] {
4487 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
4488 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
4489 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
4493 set file_lists($ui_index) [list]
4494 set file_lists($ui_workdir) [list]
4498 set MERGE_HEAD [list]
4501 set current_branch {}
4502 set current_diff_path {}
4503 set selected_commit_type new
4505 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
4506 focus -force $ui_comm
4508 # -- Warn the user about environmental problems. Cygwin's Tcl
4509 # does *not* pass its env array onto any processes it spawns.
4510 # This means that git processes get none of our environment.
4515 set msg "Possible environment issues exist.
4517 The following environment variables are probably
4518 going to be ignored by any Git subprocess run
4522 foreach name [array names env] {
4523 switch -regexp -- $name {
4524 {^GIT_INDEX_FILE$} -
4525 {^GIT_OBJECT_DIRECTORY$} -
4526 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4528 {^GIT_EXTERNAL_DIFF$} -
4532 {^GIT_CONFIG_LOCAL$} -
4533 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4534 append msg " - $name\n"
4537 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4538 append msg " - $name\n"
4540 set suggest_user $name
4544 if {$ignored_env > 0} {
4546 This is due to a known issue with the
4547 Tcl binary distributed by Cygwin.
"
4549 if {$suggest_user ne {}} {
4552 A good replacement
for $suggest_user
4553 is placing values
for the user.name and
4554 user.email settings into your personal
4560 unset ignored_env msg suggest_user name
4563 # -- Only initialize complex UI if we are going to stay running.
4565 if {!$single_commit} {
4569 populate_branch_menu
4570 populate_fetch_menu .mbar.fetch
4571 populate_pull_menu .mbar.pull
4572 populate_push_menu .mbar.push
4575 # -- Only suggest a gc run if we are going to stay running.
4577 if {!$single_commit} {
4578 set object_limit 2000
4579 if {[is_Windows]} {set object_limit 200}
4580 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4581 if {$objects_current >= $object_limit} {
4583 "This repository currently has
$objects_current loose objects.
4585 To maintain optimal performance it is strongly
4586 recommended that you
compress the database
4587 when
more than
$object_limit loose objects exist.
4589 Compress the database now?
"] eq yes} {
4593 unset object_limit _junk objects_current
4596 lock_index begin-read