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
]
43 return [eval [concat
[list
file join $_gitdir] $args]]
48 if {$_gitexec eq
{}} {
49 if {[catch
{set _gitexec
[exec git
--exec-path]} err
]} {
50 error
"Git not installed?\n\n$err"
56 return [eval [concat
[list
file join $_gitexec] $args]]
65 global tcl_platform tk_library
66 if {[tk windowingsystem
] eq
{aqua
}} {
74 if {$tcl_platform(platform
) eq
{windows
}} {
81 global tcl_platform _iscygwin
82 if {$_iscygwin eq
{}} {
83 if {$tcl_platform(platform
) eq
{windows
}} {
84 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
96 ######################################################################
100 proc is_many_config
{name
} {
101 switch
-glob -- $name {
110 proc is_config_true
{name
} {
112 if {[catch
{set v
$repo_config($name)}]} {
114 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
121 proc load_config
{include_global
} {
122 global repo_config global_config default_config
124 array
unset global_config
125 if {$include_global} {
127 set fd_rc
[open
"| git repo-config --global --list" r
]
128 while {[gets
$fd_rc line
] >= 0} {
129 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
130 if {[is_many_config
$name]} {
131 lappend global_config
($name) $value
133 set global_config
($name) $value
141 array
unset repo_config
143 set fd_rc
[open
"| git repo-config --list" r
]
144 while {[gets
$fd_rc line
] >= 0} {
145 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
146 if {[is_many_config
$name]} {
147 lappend repo_config
($name) $value
149 set repo_config
($name) $value
156 foreach name
[array names default_config
] {
157 if {[catch
{set v
$global_config($name)}]} {
158 set global_config
($name) $default_config($name)
160 if {[catch
{set v
$repo_config($name)}]} {
161 set repo_config
($name) $default_config($name)
166 proc save_config
{} {
167 global default_config font_descs
168 global repo_config global_config
169 global repo_config_new global_config_new
171 foreach option
$font_descs {
172 set name
[lindex
$option 0]
173 set font
[lindex
$option 1]
174 font configure
$font \
175 -family $global_config_new(gui.
$font^^family
) \
176 -size $global_config_new(gui.
$font^^size
)
177 font configure
${font}bold \
178 -family $global_config_new(gui.
$font^^family
) \
179 -size $global_config_new(gui.
$font^^size
)
180 set global_config_new
(gui.
$name) [font configure
$font]
181 unset global_config_new
(gui.
$font^^family
)
182 unset global_config_new
(gui.
$font^^size
)
185 foreach name
[array names default_config
] {
186 set value
$global_config_new($name)
187 if {$value ne
$global_config($name)} {
188 if {$value eq
$default_config($name)} {
189 catch
{exec git repo-config
--global --unset $name}
191 regsub
-all "\[{}\]" $value {"} value
192 exec git repo-config --global $name $value
194 set global_config($name) $value
195 if {$value eq $repo_config($name)} {
196 catch {exec git repo-config --unset $name}
197 set repo_config($name) $value
202 foreach name [array names default_config] {
203 set value $repo_config_new($name)
204 if {$value ne $repo_config($name)} {
205 if {$value eq $global_config($name)} {
206 catch {exec git repo-config --unset $name}
208 regsub -all "\
[{}\
]" $value {"} value
209 exec git repo-config
$name $value
211 set repo_config
($name) $value
216 proc error_popup
{msg
} {
218 if {[reponame
] ne
{}} {
219 append title
" ([reponame])"
221 set cmd
[list tk_messageBox \
224 -title "$title: error" \
226 if {[winfo ismapped .
]} {
227 lappend cmd
-parent .
232 proc warn_popup
{msg
} {
234 if {[reponame
] ne
{}} {
235 append title
" ([reponame])"
237 set cmd
[list tk_messageBox \
240 -title "$title: warning" \
242 if {[winfo ismapped .
]} {
243 lappend cmd
-parent .
248 proc info_popup
{msg
{parent .
}} {
250 if {[reponame
] ne
{}} {
251 append title
" ([reponame])"
261 proc ask_popup
{msg
} {
263 if {[reponame
] ne
{}} {
264 append title
" ([reponame])"
266 return [tk_messageBox \
274 ######################################################################
278 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
279 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
280 catch
{wm withdraw .
}
281 error_popup
"Cannot find the git directory:\n\n$err"
284 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
285 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
287 if {![file isdirectory
$_gitdir]} {
288 catch
{wm withdraw .
}
289 error_popup
"Git directory not found:\n\n$_gitdir"
292 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
293 catch
{wm withdraw .
}
294 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
297 if {[catch
{cd [file dirname $_gitdir]} err
]} {
298 catch
{wm withdraw .
}
299 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
302 set _reponame
[lindex
[file split \
303 [file normalize
[file dirname $_gitdir]]] \
307 if {[appname
] eq
{git-citool
}} {
311 ######################################################################
319 set disable_on_lock
[list
]
320 set index_lock_type none
322 proc lock_index
{type} {
323 global index_lock_type disable_on_lock
325 if {$index_lock_type eq
{none
}} {
326 set index_lock_type
$type
327 foreach w
$disable_on_lock {
328 uplevel
#0 $w disabled
331 } elseif
{$index_lock_type eq
"begin-$type"} {
332 set index_lock_type
$type
338 proc unlock_index
{} {
339 global index_lock_type disable_on_lock
341 set index_lock_type none
342 foreach w
$disable_on_lock {
347 ######################################################################
351 proc repository_state
{ctvar hdvar mhvar
} {
352 global current_branch
353 upvar
$ctvar ct
$hdvar hd
$mhvar mh
357 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
358 set current_branch
{}
360 regsub ^refs
/((heads|tags|remotes
)/)? \
366 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
372 set merge_head
[gitdir MERGE_HEAD
]
373 if {[file exists
$merge_head]} {
375 set fd_mh
[open
$merge_head r
]
376 while {[gets
$fd_mh line
] >= 0} {
387 global PARENT empty_tree
389 set p
[lindex
$PARENT 0]
393 if {$empty_tree eq
{}} {
394 set empty_tree
[exec git mktree
<< {}]
399 proc rescan
{after
{honor_trustmtime
1}} {
400 global HEAD PARENT MERGE_HEAD commit_type
401 global ui_index ui_workdir ui_status_value ui_comm
402 global rescan_active file_states
403 global repo_config single_commit
405 if {$rescan_active > 0 ||
![lock_index
read]} return
407 repository_state newType newHEAD newMERGE_HEAD
408 if {[string match amend
* $commit_type]
409 && $newType eq
{normal
}
410 && $newHEAD eq
$HEAD} {
414 set MERGE_HEAD
$newMERGE_HEAD
415 set commit_type
$newType
418 array
unset file_states
420 if {![$ui_comm edit modified
]
421 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
422 if {[load_message GITGUI_MSG
]} {
423 } elseif
{[load_message MERGE_MSG
]} {
424 } elseif
{[load_message SQUASH_MSG
]} {
427 $ui_comm edit modified false
430 if {!$single_commit} {
435 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
436 rescan_stage2
{} $after
439 set ui_status_value
{Refreshing
file status...
}
440 set cmd
[list git update-index
]
442 lappend cmd
--unmerged
443 lappend cmd
--ignore-missing
444 lappend cmd
--refresh
445 set fd_rf
[open
"| $cmd" r
]
446 fconfigure
$fd_rf -blocking 0 -translation binary
447 fileevent
$fd_rf readable \
448 [list rescan_stage2
$fd_rf $after]
452 proc rescan_stage2
{fd after
} {
453 global ui_status_value
454 global rescan_active buf_rdi buf_rdf buf_rlo
458 if {![eof
$fd]} return
462 set ls_others
[list | git ls-files
--others -z \
463 --exclude-per-directory=.gitignore
]
464 set info_exclude
[gitdir info exclude
]
465 if {[file readable
$info_exclude]} {
466 lappend ls_others
"--exclude-from=$info_exclude"
474 set ui_status_value
{Scanning
for modified files ...
}
475 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
476 set fd_df
[open
"| git diff-files -z" r
]
477 set fd_lo
[open
$ls_others r
]
479 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
480 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
481 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
482 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
483 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
484 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
487 proc load_message
{file} {
491 if {[file isfile
$f]} {
492 if {[catch
{set fd
[open
$f r
]}]} {
495 set content
[string trim
[read $fd]]
497 regsub
-all -line {[ \r\t]+$
} $content {} content
498 $ui_comm delete
0.0 end
499 $ui_comm insert end
$content
505 proc read_diff_index
{fd after
} {
508 append buf_rdi
[read $fd]
510 set n
[string length
$buf_rdi]
512 set z1
[string first
"\0" $buf_rdi $c]
515 set z2
[string first
"\0" $buf_rdi $z1]
519 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
520 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
522 [encoding convertfrom
$p] \
524 [list
[lindex
$i 0] [lindex
$i 2]] \
530 set buf_rdi
[string range
$buf_rdi $c end
]
535 rescan_done
$fd buf_rdi
$after
538 proc read_diff_files
{fd after
} {
541 append buf_rdf
[read $fd]
543 set n
[string length
$buf_rdf]
545 set z1
[string first
"\0" $buf_rdf $c]
548 set z2
[string first
"\0" $buf_rdf $z1]
552 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
553 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
555 [encoding convertfrom
$p] \
558 [list
[lindex
$i 0] [lindex
$i 2]]
563 set buf_rdf
[string range
$buf_rdf $c end
]
568 rescan_done
$fd buf_rdf
$after
571 proc read_ls_others
{fd after
} {
574 append buf_rlo
[read $fd]
575 set pck
[split $buf_rlo "\0"]
576 set buf_rlo
[lindex
$pck end
]
577 foreach p
[lrange
$pck 0 end-1
] {
578 merge_state
[encoding convertfrom
$p] ?O
580 rescan_done
$fd buf_rlo
$after
583 proc rescan_done
{fd buf after
} {
585 global file_states repo_config
588 if {![eof
$fd]} return
591 if {[incr rescan_active
-1] > 0} return
600 proc prune_selection
{} {
601 global file_states selected_paths
603 foreach path
[array names selected_paths
] {
604 if {[catch
{set still_here
$file_states($path)}]} {
605 unset selected_paths
($path)
610 ######################################################################
615 global ui_diff current_diff_path current_diff_header
616 global ui_index ui_workdir
618 $ui_diff conf
-state normal
619 $ui_diff delete
0.0 end
620 $ui_diff conf
-state disabled
622 set current_diff_path
{}
623 set current_diff_header
{}
625 $ui_index tag remove in_diff
0.0 end
626 $ui_workdir tag remove in_diff
0.0 end
629 proc reshow_diff
{} {
630 global ui_status_value file_states file_lists
631 global current_diff_path current_diff_side
633 set p
$current_diff_path
635 ||
$current_diff_side eq
{}
636 ||
[catch
{set s
$file_states($p)}]
637 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
640 show_diff
$p $current_diff_side
644 proc handle_empty_diff
{} {
645 global current_diff_path file_states file_lists
647 set path
$current_diff_path
648 set s
$file_states($path)
649 if {[lindex
$s 0] ne
{_M
}} return
651 info_popup
"No differences detected.
653 [short_path $path] has no changes.
655 The modification date of this file was updated
656 by another application, but the content within
657 the file was not changed.
659 A rescan will be automatically started to find
660 other files which may have the same state."
663 display_file
$path __
664 rescan
{set ui_status_value
{Ready.
}} 0
667 proc show_diff
{path w
{lno
{}}} {
668 global file_states file_lists
669 global is_3way_diff diff_active repo_config
670 global ui_diff ui_status_value ui_index ui_workdir
671 global current_diff_path current_diff_side current_diff_header
673 if {$diff_active ||
![lock_index
read]} return
677 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
683 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
686 set s
$file_states($path)
690 set current_diff_path
$path
691 set current_diff_side
$w
692 set current_diff_header
{}
693 set ui_status_value
"Loading diff of [escape_path $path]..."
695 # - Git won't give us the diff, there's nothing to compare to!
698 set max_sz
[expr {128 * 1024}]
700 set fd
[open
$path r
]
701 set content
[read $fd $max_sz]
703 set sz
[file size
$path]
707 set ui_status_value
"Unable to display [escape_path $path]"
708 error_popup
"Error loading file:\n\n$err"
711 $ui_diff conf
-state normal
712 if {![catch
{set type [exec file $path]}]} {
713 set n
[string length
$path]
714 if {[string equal
-length $n $path $type]} {
715 set type [string range
$type $n end
]
716 regsub
{^
:?\s
*} $type {} type
718 $ui_diff insert end
"* $type\n" d_@
720 if {[string first
"\0" $content] != -1} {
721 $ui_diff insert end \
722 "* Binary file (not showing content)." \
726 $ui_diff insert end \
727 "* Untracked file is $sz bytes.
728 * Showing only first $max_sz bytes.
731 $ui_diff insert end
$content
733 $ui_diff insert end
"
734 * Untracked file clipped here by [appname].
735 * To see the entire file, use an external editor.
739 $ui_diff conf
-state disabled
742 set ui_status_value
{Ready.
}
747 if {$w eq
$ui_index} {
748 lappend cmd diff-index
750 } elseif
{$w eq
$ui_workdir} {
751 if {[string index
$m 0] eq
{U
}} {
754 lappend cmd diff-files
759 lappend cmd
--no-color
760 if {$repo_config(gui.diffcontext
) > 0} {
761 lappend cmd
"-U$repo_config(gui.diffcontext)"
763 if {$w eq
$ui_index} {
769 if {[catch
{set fd
[open
$cmd r
]} err
]} {
772 set ui_status_value
"Unable to display [escape_path $path]"
773 error_popup
"Error loading diff:\n\n$err"
781 fileevent
$fd readable
[list read_diff
$fd]
784 proc read_diff
{fd
} {
785 global ui_diff ui_status_value diff_active
786 global is_3way_diff current_diff_header
788 $ui_diff conf
-state normal
789 while {[gets
$fd line
] >= 0} {
790 # -- Cleanup uninteresting diff header lines.
792 if { [string match
{diff --git *} $line]
793 ||
[string match
{diff --cc *} $line]
794 ||
[string match
{diff --combined *} $line]
795 ||
[string match
{--- *} $line]
796 ||
[string match
{+++ *} $line]} {
797 append current_diff_header
$line "\n"
800 if {[string match
{index
*} $line]} continue
801 if {$line eq
{deleted
file mode
120000}} {
802 set line
"deleted symlink"
805 # -- Automatically detect if this is a 3 way diff.
807 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
809 if {[string match
{mode
*} $line]
810 ||
[string match
{new
file *} $line]
811 ||
[string match
{deleted
file *} $line]
812 ||
[string match
{Binary files
* and
* differ
} $line]
813 ||
$line eq
{\ No newline
at end of
file}
814 ||
[regexp
{^\
* Unmerged path
} $line]} {
816 } elseif
{$is_3way_diff} {
817 set op
[string range
$line 0 1]
827 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
828 set line
[string replace
$line 0 1 { }]
835 puts
"error: Unhandled 3 way diff marker: {$op}"
840 set op
[string index
$line 0]
846 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
847 set line
[string replace
$line 0 0 { }]
854 puts
"error: Unhandled 2 way diff marker: {$op}"
859 $ui_diff insert end
$line $tags
860 if {[string index
$line end
] eq
"\r"} {
861 $ui_diff tag add d_cr
{end
- 2c
}
863 $ui_diff insert end
"\n" $tags
865 $ui_diff conf
-state disabled
871 set ui_status_value
{Ready.
}
873 if {[$ui_diff index end
] eq
{2.0}} {
879 proc apply_hunk
{x y
} {
880 global current_diff_path current_diff_header current_diff_side
881 global ui_diff ui_index file_states
883 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
884 if {![lock_index apply_hunk
]} return
886 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
887 set mi
[lindex
$file_states($current_diff_path) 0]
888 if {$current_diff_side eq
$ui_index} {
890 lappend apply_cmd
--reverse
891 if {[string index
$mi 0] ne
{M
}} {
897 if {[string index
$mi 1] ne
{M
}} {
903 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
904 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
910 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
916 set p
[open
"| $apply_cmd" w
]
917 fconfigure
$p -translation binary
-encoding binary
918 puts
-nonewline $p $current_diff_header
919 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
921 error_popup
"Failed to $mode selected hunk.\n\n$err"
926 $ui_diff conf
-state normal
927 $ui_diff delete
$s_lno $e_lno
928 $ui_diff conf
-state disabled
930 if {[$ui_diff get
1.0 end
] eq
"\n"} {
936 if {$current_diff_side eq
$ui_index} {
938 } elseif
{[string index
$mi 0] eq
{_
}} {
944 display_file
$current_diff_path $mi
950 ######################################################################
954 proc load_last_commit
{} {
955 global HEAD PARENT MERGE_HEAD commit_type ui_comm
958 if {[llength
$PARENT] == 0} {
959 error_popup
{There is nothing to amend.
961 You are about to create the initial commit.
962 There is no commit before this to amend.
967 repository_state curType curHEAD curMERGE_HEAD
968 if {$curType eq
{merge
}} {
969 error_popup
{Cannot amend
while merging.
971 You are currently
in the middle of a merge that
972 has not been fully completed. You cannot amend
973 the prior commit unless you first abort the
974 current merge activity.
982 set fd
[open
"| git cat-file commit $curHEAD" r
]
983 fconfigure
$fd -encoding binary
-translation lf
984 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
987 while {[gets
$fd line
] > 0} {
988 if {[string match
{parent
*} $line]} {
989 lappend parents
[string range
$line 7 end
]
990 } elseif
{[string match
{encoding
*} $line]} {
991 set enc
[string tolower
[string range
$line 9 end
]]
994 fconfigure
$fd -encoding $enc
995 set msg
[string trim
[read $fd]]
998 error_popup
"Error loading commit data for amend:\n\n$err"
1004 set MERGE_HEAD
[list
]
1005 switch
-- [llength
$parents] {
1006 0 {set commit_type amend-initial
}
1007 1 {set commit_type amend
}
1008 default
{set commit_type amend-merge
}
1011 $ui_comm delete
0.0 end
1012 $ui_comm insert end
$msg
1014 $ui_comm edit modified false
1015 rescan
{set ui_status_value
{Ready.
}}
1018 proc create_new_commit
{} {
1019 global commit_type ui_comm
1021 set commit_type normal
1022 $ui_comm delete
0.0 end
1024 $ui_comm edit modified false
1025 rescan
{set ui_status_value
{Ready.
}}
1028 set GIT_COMMITTER_IDENT
{}
1030 proc committer_ident
{} {
1031 global GIT_COMMITTER_IDENT
1033 if {$GIT_COMMITTER_IDENT eq
{}} {
1034 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1035 error_popup
"Unable to obtain your identity:\n\n$err"
1038 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1039 $me me GIT_COMMITTER_IDENT
]} {
1040 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1045 return $GIT_COMMITTER_IDENT
1048 proc commit_tree
{} {
1049 global HEAD commit_type file_states ui_comm repo_config
1050 global ui_status_value pch_error
1052 if {[committer_ident
] eq
{}} return
1053 if {![lock_index update
]} return
1055 # -- Our in memory state should match the repository.
1057 repository_state curType curHEAD curMERGE_HEAD
1058 if {[string match amend
* $commit_type]
1059 && $curType eq
{normal
}
1060 && $curHEAD eq
$HEAD} {
1061 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1062 info_popup
{Last scanned state does not match repository state.
1064 Another Git program has modified this repository
1065 since the last scan. A rescan must be performed
1066 before another commit can be created.
1068 The rescan will be automatically started now.
1071 rescan
{set ui_status_value
{Ready.
}}
1075 # -- At least one file should differ in the index.
1078 foreach path
[array names file_states
] {
1079 switch
-glob -- [lindex
$file_states($path) 0] {
1083 M?
{set files_ready
1}
1085 error_popup
"Unmerged files cannot be committed.
1087 File [short_path $path] has merge conflicts.
1088 You must resolve them and add the file before committing.
1094 error_popup
"Unknown file state [lindex $s 0] detected.
1096 File [short_path $path] cannot be committed by this program.
1101 if {!$files_ready} {
1102 info_popup
{No changes to commit.
1104 You must add
at least
1 file before you can commit.
1110 # -- A message is required.
1112 set msg
[string trim
[$ui_comm get
1.0 end
]]
1113 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1115 error_popup
{Please supply a commit message.
1117 A good commit message has the following format
:
1119 - First line
: Describe
in one sentance what you did.
1120 - Second line
: Blank
1121 - Remaining lines
: Describe why this change is good.
1127 # -- Run the pre-commit hook.
1129 set pchook
[gitdir hooks pre-commit
]
1131 # On Cygwin [file executable] might lie so we need to ask
1132 # the shell if the hook is executable. Yes that's annoying.
1134 if {[is_Cygwin
] && [file isfile
$pchook]} {
1135 set pchook
[list sh
-c [concat \
1136 "if test -x \"$pchook\";" \
1137 "then exec \"$pchook\" 2>&1;" \
1139 } elseif
{[file executable
$pchook]} {
1140 set pchook
[list
$pchook |
& cat]
1142 commit_writetree
$curHEAD $msg
1146 set ui_status_value
{Calling pre-commit hook...
}
1148 set fd_ph
[open
"| $pchook" r
]
1149 fconfigure
$fd_ph -blocking 0 -translation binary
1150 fileevent
$fd_ph readable \
1151 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1154 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1155 global pch_error ui_status_value
1157 append pch_error
[read $fd_ph]
1158 fconfigure
$fd_ph -blocking 1
1160 if {[catch
{close
$fd_ph}]} {
1161 set ui_status_value
{Commit declined by pre-commit hook.
}
1162 hook_failed_popup pre-commit
$pch_error
1165 commit_writetree
$curHEAD $msg
1170 fconfigure
$fd_ph -blocking 0
1173 proc commit_writetree
{curHEAD msg
} {
1174 global ui_status_value
1176 set ui_status_value
{Committing changes...
}
1177 set fd_wt
[open
"| git write-tree" r
]
1178 fileevent
$fd_wt readable \
1179 [list commit_committree
$fd_wt $curHEAD $msg]
1182 proc commit_committree
{fd_wt curHEAD msg
} {
1183 global HEAD PARENT MERGE_HEAD commit_type
1184 global single_commit all_heads current_branch
1185 global ui_status_value ui_comm selected_commit_type
1186 global file_states selected_paths rescan_active
1190 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1191 error_popup
"write-tree failed:\n\n$err"
1192 set ui_status_value
{Commit failed.
}
1197 # -- Build the message.
1199 set msg_p
[gitdir COMMIT_EDITMSG
]
1200 set msg_wt
[open
$msg_p w
]
1201 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1204 fconfigure
$msg_wt -encoding $enc -translation binary
1205 puts
-nonewline $msg_wt $msg
1208 # -- Create the commit.
1210 set cmd
[list git commit-tree
$tree_id]
1211 set parents
[concat
$PARENT $MERGE_HEAD]
1212 if {[llength
$parents] > 0} {
1213 foreach p
$parents {
1217 # git commit-tree writes to stderr during initial commit.
1218 lappend cmd
2>/dev
/null
1221 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1222 error_popup
"commit-tree failed:\n\n$err"
1223 set ui_status_value
{Commit failed.
}
1228 # -- Update the HEAD ref.
1231 if {$commit_type ne
{normal
}} {
1232 append reflogm
" ($commit_type)"
1234 set i
[string first
"\n" $msg]
1236 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1238 append reflogm
{: } $msg
1240 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1241 if {[catch
{eval exec $cmd} err
]} {
1242 error_popup
"update-ref failed:\n\n$err"
1243 set ui_status_value
{Commit failed.
}
1248 # -- Make sure our current branch exists.
1250 if {$commit_type eq
{initial
}} {
1251 lappend all_heads
$current_branch
1252 set all_heads
[lsort
-unique $all_heads]
1253 populate_branch_menu
1256 # -- Cleanup after ourselves.
1258 catch
{file delete
$msg_p}
1259 catch
{file delete
[gitdir MERGE_HEAD
]}
1260 catch
{file delete
[gitdir MERGE_MSG
]}
1261 catch
{file delete
[gitdir SQUASH_MSG
]}
1262 catch
{file delete
[gitdir GITGUI_MSG
]}
1264 # -- Let rerere do its thing.
1266 if {[file isdirectory
[gitdir rr-cache
]]} {
1267 catch
{exec git rerere
}
1270 # -- Run the post-commit hook.
1272 set pchook
[gitdir hooks post-commit
]
1273 if {[is_Cygwin
] && [file isfile
$pchook]} {
1274 set pchook
[list sh
-c [concat \
1275 "if test -x \"$pchook\";" \
1276 "then exec \"$pchook\";" \
1278 } elseif
{![file executable
$pchook]} {
1281 if {$pchook ne
{}} {
1282 catch
{exec $pchook &}
1285 $ui_comm delete
0.0 end
1287 $ui_comm edit modified false
1289 if {$single_commit} do_quit
1291 # -- Update in memory status
1293 set selected_commit_type new
1294 set commit_type normal
1297 set MERGE_HEAD
[list
]
1299 foreach path
[array names file_states
] {
1300 set s
$file_states($path)
1302 switch
-glob -- $m {
1310 unset file_states
($path)
1311 catch
{unset selected_paths
($path)}
1314 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1320 set file_states
($path) [list \
1321 _
[string index
$m 1] \
1332 set ui_status_value \
1333 "Changes committed as [string range $cmt_id 0 7]."
1336 ######################################################################
1340 proc fetch_from
{remote
} {
1341 set w
[new_console \
1343 "Fetching new changes from $remote"]
1344 set cmd
[list git fetch
]
1346 console_exec
$w $cmd console_done
1349 proc push_to
{remote
} {
1350 set w
[new_console \
1352 "Pushing changes to $remote"]
1353 set cmd
[list git push
]
1356 console_exec
$w $cmd console_done
1359 ######################################################################
1363 proc mapicon
{w state path
} {
1366 if {[catch
{set r
$all_icons($state$w)}]} {
1367 puts
"error: no icon for $w state={$state} $path"
1373 proc mapdesc
{state path
} {
1376 if {[catch
{set r
$all_descs($state)}]} {
1377 puts
"error: no desc for state={$state} $path"
1383 proc escape_path
{path
} {
1384 regsub
-all "\n" $path "\\n" path
1388 proc short_path
{path
} {
1389 return [escape_path
[lindex
[file split $path] end
]]
1393 set null_sha1
[string repeat
0 40]
1395 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1396 global file_states next_icon_id null_sha1
1398 set s0
[string index
$new_state 0]
1399 set s1
[string index
$new_state 1]
1401 if {[catch
{set info
$file_states($path)}]} {
1403 set icon n
[incr next_icon_id
]
1405 set state
[lindex
$info 0]
1406 set icon
[lindex
$info 1]
1407 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1408 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1411 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1412 elseif
{$s0 eq
{_
}} {set s0 _
}
1414 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1415 elseif
{$s1 eq
{_
}} {set s1 _
}
1417 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1418 set head_info
[list
0 $null_sha1]
1419 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1420 && $head_info eq
{}} {
1421 set head_info
$index_info
1424 set file_states
($path) [list
$s0$s1 $icon \
1425 $head_info $index_info \
1430 proc display_file_helper
{w path icon_name old_m new_m
} {
1433 if {$new_m eq
{_
}} {
1434 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1436 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1438 $w conf
-state normal
1439 $w delete
$lno.0 [expr {$lno + 1}].0
1440 $w conf
-state disabled
1442 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1443 lappend file_lists
($w) $path
1444 set file_lists
($w) [lsort
-unique $file_lists($w)]
1445 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1447 $w conf
-state normal
1448 $w image create
$lno.0 \
1449 -align center
-padx 5 -pady 1 \
1451 -image [mapicon
$w $new_m $path]
1452 $w insert
$lno.1 "[escape_path $path]\n"
1453 $w conf
-state disabled
1454 } elseif
{$old_m ne
$new_m} {
1455 $w conf
-state normal
1456 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1457 $w conf
-state disabled
1461 proc display_file
{path state
} {
1462 global file_states selected_paths
1463 global ui_index ui_workdir
1465 set old_m
[merge_state
$path $state]
1466 set s
$file_states($path)
1467 set new_m
[lindex
$s 0]
1468 set icon_name
[lindex
$s 1]
1470 set o
[string index
$old_m 0]
1471 set n
[string index
$new_m 0]
1478 display_file_helper
$ui_index $path $icon_name $o $n
1480 if {[string index
$old_m 0] eq
{U
}} {
1483 set o
[string index
$old_m 1]
1485 if {[string index
$new_m 0] eq
{U
}} {
1488 set n
[string index
$new_m 1]
1490 display_file_helper
$ui_workdir $path $icon_name $o $n
1492 if {$new_m eq
{__
}} {
1493 unset file_states
($path)
1494 catch
{unset selected_paths
($path)}
1498 proc display_all_files_helper
{w path icon_name m
} {
1501 lappend file_lists
($w) $path
1502 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1503 $w image create end \
1504 -align center
-padx 5 -pady 1 \
1506 -image [mapicon
$w $m $path]
1507 $w insert end
"[escape_path $path]\n"
1510 proc display_all_files
{} {
1511 global ui_index ui_workdir
1512 global file_states file_lists
1515 $ui_index conf
-state normal
1516 $ui_workdir conf
-state normal
1518 $ui_index delete
0.0 end
1519 $ui_workdir delete
0.0 end
1522 set file_lists
($ui_index) [list
]
1523 set file_lists
($ui_workdir) [list
]
1525 foreach path
[lsort
[array names file_states
]] {
1526 set s
$file_states($path)
1528 set icon_name
[lindex
$s 1]
1530 set s
[string index
$m 0]
1531 if {$s ne
{U
} && $s ne
{_
}} {
1532 display_all_files_helper
$ui_index $path \
1536 if {[string index
$m 0] eq
{U
}} {
1539 set s
[string index
$m 1]
1542 display_all_files_helper
$ui_workdir $path \
1547 $ui_index conf
-state disabled
1548 $ui_workdir conf
-state disabled
1551 proc update_indexinfo
{msg pathList after
} {
1552 global update_index_cp ui_status_value
1554 if {![lock_index update
]} return
1556 set update_index_cp
0
1557 set pathList
[lsort
$pathList]
1558 set totalCnt
[llength
$pathList]
1559 set batch [expr {int
($totalCnt * .01) + 1}]
1560 if {$batch > 25} {set batch 25}
1562 set ui_status_value
[format \
1563 "$msg... %i/%i files (%.2f%%)" \
1567 set fd
[open
"| git update-index -z --index-info" w
]
1574 fileevent
$fd writable
[list \
1575 write_update_indexinfo \
1585 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1586 global update_index_cp ui_status_value
1587 global file_states current_diff_path
1589 if {$update_index_cp >= $totalCnt} {
1596 for {set i
$batch} \
1597 {$update_index_cp < $totalCnt && $i > 0} \
1599 set path
[lindex
$pathList $update_index_cp]
1600 incr update_index_cp
1602 set s
$file_states($path)
1603 switch
-glob -- [lindex
$s 0] {
1610 set info
[lindex
$s 2]
1611 if {$info eq
{}} continue
1613 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1614 display_file
$path $new
1617 set ui_status_value
[format \
1618 "$msg... %i/%i files (%.2f%%)" \
1621 [expr {100.0 * $update_index_cp / $totalCnt}]]
1624 proc update_index
{msg pathList after
} {
1625 global update_index_cp ui_status_value
1627 if {![lock_index update
]} return
1629 set update_index_cp
0
1630 set pathList
[lsort
$pathList]
1631 set totalCnt
[llength
$pathList]
1632 set batch [expr {int
($totalCnt * .01) + 1}]
1633 if {$batch > 25} {set batch 25}
1635 set ui_status_value
[format \
1636 "$msg... %i/%i files (%.2f%%)" \
1640 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1647 fileevent
$fd writable
[list \
1648 write_update_index \
1658 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1659 global update_index_cp ui_status_value
1660 global file_states current_diff_path
1662 if {$update_index_cp >= $totalCnt} {
1669 for {set i
$batch} \
1670 {$update_index_cp < $totalCnt && $i > 0} \
1672 set path
[lindex
$pathList $update_index_cp]
1673 incr update_index_cp
1675 switch
-glob -- [lindex
$file_states($path) 0] {
1681 if {[file exists
$path]} {
1690 puts
-nonewline $fd "[encoding convertto $path]\0"
1691 display_file
$path $new
1694 set ui_status_value
[format \
1695 "$msg... %i/%i files (%.2f%%)" \
1698 [expr {100.0 * $update_index_cp / $totalCnt}]]
1701 proc checkout_index
{msg pathList after
} {
1702 global update_index_cp ui_status_value
1704 if {![lock_index update
]} return
1706 set update_index_cp
0
1707 set pathList
[lsort
$pathList]
1708 set totalCnt
[llength
$pathList]
1709 set batch [expr {int
($totalCnt * .01) + 1}]
1710 if {$batch > 25} {set batch 25}
1712 set ui_status_value
[format \
1713 "$msg... %i/%i files (%.2f%%)" \
1717 set cmd
[list git checkout-index
]
1723 set fd
[open
"| $cmd " w
]
1730 fileevent
$fd writable
[list \
1731 write_checkout_index \
1741 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1742 global update_index_cp ui_status_value
1743 global file_states current_diff_path
1745 if {$update_index_cp >= $totalCnt} {
1752 for {set i
$batch} \
1753 {$update_index_cp < $totalCnt && $i > 0} \
1755 set path
[lindex
$pathList $update_index_cp]
1756 incr update_index_cp
1757 switch
-glob -- [lindex
$file_states($path) 0] {
1761 puts
-nonewline $fd "[encoding convertto $path]\0"
1762 display_file
$path ?_
1767 set ui_status_value
[format \
1768 "$msg... %i/%i files (%.2f%%)" \
1771 [expr {100.0 * $update_index_cp / $totalCnt}]]
1774 ######################################################################
1776 ## branch management
1778 proc is_tracking_branch
{name
} {
1779 global tracking_branches
1781 if {![catch
{set info
$tracking_branches($name)}]} {
1784 foreach t
[array names tracking_branches
] {
1785 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1792 proc load_all_heads
{} {
1795 set all_heads
[list
]
1796 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1797 while {[gets
$fd line
] > 0} {
1798 if {[is_tracking_branch
$line]} continue
1799 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1800 lappend all_heads
$name
1804 set all_heads
[lsort
$all_heads]
1807 proc populate_branch_menu
{} {
1808 global all_heads disable_on_lock
1811 set last
[$m index last
]
1812 for {set i
0} {$i <= $last} {incr i
} {
1813 if {[$m type $i] eq
{separator
}} {
1816 foreach a
$disable_on_lock {
1817 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1821 set disable_on_lock
$new_dol
1826 if {$all_heads ne
{}} {
1829 foreach b
$all_heads {
1830 $m add radiobutton \
1832 -command [list switch_branch
$b] \
1833 -variable current_branch \
1836 lappend disable_on_lock \
1837 [list
$m entryconf
[$m index last
] -state]
1841 proc all_tracking_branches
{} {
1842 global tracking_branches
1844 set all_trackings
{}
1846 foreach name
[array names tracking_branches
] {
1847 if {[regsub
{/\
*$
} $name {} name
]} {
1850 regsub ^refs
/(heads|remotes
)/ $name {} name
1851 lappend all_trackings
$name
1856 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1857 while {[gets
$fd name
] > 0} {
1858 regsub ^refs
/(heads|remotes
)/ $name {} name
1859 lappend all_trackings
$name
1864 return [lsort
-unique $all_trackings]
1867 proc do_create_branch_action
{w
} {
1868 global all_heads null_sha1 repo_config
1869 global create_branch_checkout create_branch_revtype
1870 global create_branch_head create_branch_trackinghead
1871 global create_branch_name create_branch_revexp
1873 set newbranch
$create_branch_name
1874 if {$newbranch eq
{}
1875 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1879 -title [wm title
$w] \
1881 -message "Please supply a branch name."
1882 focus
$w.desc.name_t
1885 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1889 -title [wm title
$w] \
1891 -message "Branch '$newbranch' already exists."
1892 focus
$w.desc.name_t
1895 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1899 -title [wm title
$w] \
1901 -message "We do not like '$newbranch' as a branch name."
1902 focus
$w.desc.name_t
1907 switch
-- $create_branch_revtype {
1908 head {set rev $create_branch_head}
1909 tracking
{set rev $create_branch_trackinghead}
1910 expression
{set rev $create_branch_revexp}
1912 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1916 -title [wm title
$w] \
1918 -message "Invalid starting revision: $rev"
1921 set cmd
[list git update-ref
]
1923 lappend cmd
"branch: Created from $rev"
1924 lappend cmd
"refs/heads/$newbranch"
1926 lappend cmd
$null_sha1
1927 if {[catch
{eval exec $cmd} err
]} {
1931 -title [wm title
$w] \
1933 -message "Failed to create '$newbranch'.\n\n$err"
1937 lappend all_heads
$newbranch
1938 set all_heads
[lsort
$all_heads]
1939 populate_branch_menu
1941 if {$create_branch_checkout} {
1942 switch_branch
$newbranch
1946 proc radio_selector
{varname value args
} {
1947 upvar
#0 $varname var
1951 trace add variable create_branch_head
write \
1952 [list radio_selector create_branch_revtype
head]
1953 trace add variable create_branch_trackinghead
write \
1954 [list radio_selector create_branch_revtype tracking
]
1956 trace add variable delete_branch_head
write \
1957 [list radio_selector delete_branch_checktype
head]
1958 trace add variable delete_branch_trackinghead
write \
1959 [list radio_selector delete_branch_checktype tracking
]
1961 proc do_create_branch
{} {
1962 global all_heads current_branch repo_config
1963 global create_branch_checkout create_branch_revtype
1964 global create_branch_head create_branch_trackinghead
1965 global create_branch_name create_branch_revexp
1967 set w .branch_editor
1969 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1971 label
$w.header
-text {Create New Branch
} \
1973 pack
$w.header
-side top
-fill x
1976 button
$w.buttons.create
-text Create \
1979 -command [list do_create_branch_action
$w]
1980 pack
$w.buttons.create
-side right
1981 button
$w.buttons.cancel
-text {Cancel
} \
1983 -command [list destroy
$w]
1984 pack
$w.buttons.cancel
-side right
-padx 5
1985 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1987 labelframe
$w.desc \
1988 -text {Branch Description
} \
1990 label
$w.desc.name_l
-text {Name
:} -font font_ui
1991 entry
$w.desc.name_t \
1995 -textvariable create_branch_name \
1999 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
2002 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
2003 grid columnconfigure
$w.desc
1 -weight 1
2004 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2006 labelframe
$w.from \
2007 -text {Starting Revision
} \
2009 radiobutton
$w.from.head_r \
2010 -text {Local Branch
:} \
2012 -variable create_branch_revtype \
2014 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2015 grid
$w.from.head_r
$w.from.head_m
-sticky w
2016 set all_trackings
[all_tracking_branches
]
2017 if {$all_trackings ne
{}} {
2018 set create_branch_trackinghead
[lindex
$all_trackings 0]
2019 radiobutton
$w.from.tracking_r \
2020 -text {Tracking Branch
:} \
2022 -variable create_branch_revtype \
2024 eval tk_optionMenu
$w.from.tracking_m \
2025 create_branch_trackinghead \
2027 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2029 radiobutton
$w.from.exp_r \
2030 -text {Revision Expression
:} \
2032 -variable create_branch_revtype \
2034 entry
$w.from.exp_t \
2038 -textvariable create_branch_revexp \
2042 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2043 if {%d
== 1 && [string length
%S
] > 0} {
2044 set create_branch_revtype expression
2048 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2049 grid columnconfigure
$w.from
1 -weight 1
2050 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2052 labelframe
$w.postActions \
2053 -text {Post Creation Actions
} \
2055 checkbutton
$w.postActions.checkout \
2056 -text {Checkout after creation
} \
2057 -variable create_branch_checkout \
2059 pack
$w.postActions.checkout
-anchor nw
2060 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2062 set create_branch_checkout
1
2063 set create_branch_head
$current_branch
2064 set create_branch_revtype
head
2065 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2066 set create_branch_revexp
{}
2068 bind $w <Visibility
> "
2070 $w.desc.name_t icursor end
2071 focus $w.desc.name_t
2073 bind $w <Key-Escape
> "destroy $w"
2074 bind $w <Key-Return
> "do_create_branch_action $w;break"
2075 wm title
$w "[appname] ([reponame]): Create Branch"
2079 proc do_delete_branch_action
{w
} {
2081 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2084 switch
-- $delete_branch_checktype {
2085 head {set check_rev
$delete_branch_head}
2086 tracking
{set check_rev
$delete_branch_trackinghead}
2087 always
{set check_rev
{:none
}}
2089 if {$check_rev eq
{:none
}} {
2091 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2095 -title [wm title
$w] \
2097 -message "Invalid check revision: $check_rev"
2101 set to_delete
[list
]
2102 set not_merged
[list
]
2103 foreach i
[$w.list.l curselection
] {
2104 set b
[$w.list.l get
$i]
2105 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2106 if {$check_cmt ne
{}} {
2107 if {$b eq
$check_rev} continue
2108 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2110 lappend not_merged
$b
2114 lappend to_delete
[list
$b $o]
2116 if {$not_merged ne
{}} {
2117 set msg
"The following branches are not completely merged into $check_rev:
2119 - [join $not_merged "\n - "]"
2123 -title [wm title
$w] \
2127 if {$to_delete eq
{}} return
2128 if {$delete_branch_checktype eq
{always
}} {
2129 set msg
{Recovering deleted branches is difficult.
2131 Delete the selected branches?
}
2132 if {[tk_messageBox \
2135 -title [wm title
$w] \
2137 -message $msg] ne
yes} {
2143 foreach i
$to_delete {
2146 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2147 append failed
" - $b: $err\n"
2149 set x
[lsearch
-sorted -exact $all_heads $b]
2151 set all_heads
[lreplace
$all_heads $x $x]
2156 if {$failed ne
{}} {
2160 -title [wm title
$w] \
2162 -message "Failed to delete branches:\n$failed"
2165 set all_heads
[lsort
$all_heads]
2166 populate_branch_menu
2170 proc do_delete_branch
{} {
2171 global all_heads tracking_branches current_branch
2172 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2174 set w .branch_editor
2176 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2178 label
$w.header
-text {Delete Local Branch
} \
2180 pack
$w.header
-side top
-fill x
2183 button
$w.buttons.create
-text Delete \
2185 -command [list do_delete_branch_action
$w]
2186 pack
$w.buttons.create
-side right
2187 button
$w.buttons.cancel
-text {Cancel
} \
2189 -command [list destroy
$w]
2190 pack
$w.buttons.cancel
-side right
-padx 5
2191 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2193 labelframe
$w.list \
2194 -text {Local Branches
} \
2199 -selectmode extended \
2200 -yscrollcommand [list
$w.list.sby
set] \
2202 foreach h
$all_heads {
2203 if {$h ne
$current_branch} {
2204 $w.list.l insert end
$h
2207 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2208 pack
$w.list.sby
-side right
-fill y
2209 pack
$w.list.l
-side left
-fill both
-expand 1
2210 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2212 labelframe
$w.validate \
2213 -text {Delete Only If
} \
2215 radiobutton
$w.validate.head_r \
2216 -text {Merged Into Local Branch
:} \
2218 -variable delete_branch_checktype \
2220 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2221 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2222 set all_trackings
[all_tracking_branches
]
2223 if {$all_trackings ne
{}} {
2224 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2225 radiobutton
$w.validate.tracking_r \
2226 -text {Merged Into Tracking Branch
:} \
2228 -variable delete_branch_checktype \
2230 eval tk_optionMenu
$w.validate.tracking_m \
2231 delete_branch_trackinghead \
2233 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2235 radiobutton
$w.validate.always_r \
2236 -text {Always
(Do not perform merge checks
)} \
2238 -variable delete_branch_checktype \
2240 grid
$w.validate.always_r
-columnspan 2 -sticky w
2241 grid columnconfigure
$w.validate
1 -weight 1
2242 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2244 set delete_branch_head
$current_branch
2245 set delete_branch_checktype
head
2247 bind $w <Visibility
> "grab $w; focus $w"
2248 bind $w <Key-Escape
> "destroy $w"
2249 wm title
$w "[appname] ([reponame]): Delete Branch"
2253 proc switch_branch
{new_branch
} {
2254 global HEAD commit_type current_branch repo_config
2256 if {![lock_index switch
]} return
2258 # -- Our in memory state should match the repository.
2260 repository_state curType curHEAD curMERGE_HEAD
2261 if {[string match amend
* $commit_type]
2262 && $curType eq
{normal
}
2263 && $curHEAD eq
$HEAD} {
2264 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2265 info_popup
{Last scanned state does not match repository state.
2267 Another Git program has modified this repository
2268 since the last scan. A rescan must be performed
2269 before the current branch can be changed.
2271 The rescan will be automatically started now.
2274 rescan
{set ui_status_value
{Ready.
}}
2278 # -- Don't do a pointless switch.
2280 if {$current_branch eq
$new_branch} {
2285 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2286 switch_branch_stage2
{} $new_branch
2288 set ui_status_value
{Refreshing
file status...
}
2289 set cmd
[list git update-index
]
2291 lappend cmd
--unmerged
2292 lappend cmd
--ignore-missing
2293 lappend cmd
--refresh
2294 set fd_rf
[open
"| $cmd" r
]
2295 fconfigure
$fd_rf -blocking 0 -translation binary
2296 fileevent
$fd_rf readable \
2297 [list switch_branch_stage2
$fd_rf $new_branch]
2301 proc switch_branch_stage2
{fd_rf new_branch
} {
2302 global ui_status_value HEAD
2306 if {![eof
$fd_rf]} return
2310 set ui_status_value
"Updating working directory to '$new_branch'..."
2311 set cmd
[list git read-tree
]
2314 lappend cmd
--exclude-per-directory=.gitignore
2316 lappend cmd
$new_branch
2317 set fd_rt
[open
"| $cmd" r
]
2318 fconfigure
$fd_rt -blocking 0 -translation binary
2319 fileevent
$fd_rt readable \
2320 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2323 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2324 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2325 global current_branch
2326 global ui_comm ui_status_value
2328 # -- We never get interesting output on stdout; only stderr.
2331 fconfigure
$fd_rt -blocking 1
2332 if {![eof
$fd_rt]} {
2333 fconfigure
$fd_rt -blocking 0
2337 # -- The working directory wasn't in sync with the index and
2338 # we'd have to overwrite something to make the switch. A
2339 # merge is required.
2341 if {[catch
{close
$fd_rt} err
]} {
2342 regsub
{^fatal
: } $err {} err
2343 warn_popup
"File level merge required.
2347 Staying on branch '$current_branch'."
2348 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2353 # -- Update the symbolic ref. Core git doesn't even check for failure
2354 # here, it Just Works(tm). If it doesn't we are in some really ugly
2355 # state that is difficult to recover from within git-gui.
2357 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2358 error_popup
"Failed to set current branch.
2360 This working directory is only partially switched.
2361 We successfully updated your files, but failed to
2362 update an internal Git file.
2364 This should not have occurred. [appname] will now
2372 # -- Update our repository state. If we were previously in amend mode
2373 # we need to toss the current buffer and do a full rescan to update
2374 # our file lists. If we weren't in amend mode our file lists are
2375 # accurate and we can avoid the rescan.
2378 set selected_commit_type new
2379 if {[string match amend
* $commit_type]} {
2380 $ui_comm delete
0.0 end
2382 $ui_comm edit modified false
2383 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2385 repository_state commit_type HEAD MERGE_HEAD
2387 set ui_status_value
"Checked out branch '$current_branch'."
2391 ######################################################################
2393 ## remote management
2395 proc load_all_remotes
{} {
2397 global all_remotes tracking_branches
2399 set all_remotes
[list
]
2400 array
unset tracking_branches
2402 set rm_dir
[gitdir remotes
]
2403 if {[file isdirectory
$rm_dir]} {
2404 set all_remotes
[glob \
2408 -directory $rm_dir *]
2410 foreach name
$all_remotes {
2412 set fd
[open
[file join $rm_dir $name] r
]
2413 while {[gets
$fd line
] >= 0} {
2414 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2415 $line line src dst
]} continue
2416 if {![regexp ^refs
/ $dst]} {
2417 set dst
"refs/heads/$dst"
2419 set tracking_branches
($dst) [list
$name $src]
2426 foreach line
[array names repo_config remote.
*.url
] {
2427 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2428 lappend all_remotes
$name
2430 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2434 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2435 if {![regexp ^refs
/ $dst]} {
2436 set dst
"refs/heads/$dst"
2438 set tracking_branches
($dst) [list
$name $src]
2442 set all_remotes
[lsort
-unique $all_remotes]
2445 proc populate_fetch_menu
{} {
2446 global all_remotes repo_config
2449 foreach r
$all_remotes {
2451 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2452 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2457 set fd
[open
[gitdir remotes
$r] r
]
2458 while {[gets
$fd n
] >= 0} {
2459 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2470 -label "Fetch from $r..." \
2471 -command [list fetch_from
$r] \
2477 proc populate_push_menu
{} {
2478 global all_remotes repo_config
2482 foreach r
$all_remotes {
2484 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2485 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2490 set fd
[open
[gitdir remotes
$r] r
]
2491 while {[gets
$fd n
] >= 0} {
2492 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2506 -label "Push to $r..." \
2507 -command [list push_to
$r] \
2514 proc start_push_anywhere_action
{w
} {
2515 global push_urltype push_remote push_url push_thin push_tags
2518 switch
-- $push_urltype {
2519 remote
{set r_url
$push_remote}
2520 url
{set r_url
$push_url}
2522 if {$r_url eq
{}} return
2524 set cmd
[list git push
]
2534 foreach i
[$w.
source.l curselection
] {
2535 set b
[$w.
source.l get
$i]
2536 lappend cmd
"refs/heads/$b:refs/heads/$b"
2541 } elseif
{$cnt == 1} {
2547 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2548 console_exec
$cons $cmd console_done
2552 trace add variable push_remote
write \
2553 [list radio_selector push_urltype remote
]
2555 proc do_push_anywhere
{} {
2556 global all_heads all_remotes current_branch
2557 global push_urltype push_remote push_url push_thin push_tags
2561 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2563 label
$w.header
-text {Push Branches
} -font font_uibold
2564 pack
$w.header
-side top
-fill x
2567 button
$w.buttons.create
-text Push \
2569 -command [list start_push_anywhere_action
$w]
2570 pack
$w.buttons.create
-side right
2571 button
$w.buttons.cancel
-text {Cancel
} \
2573 -command [list destroy
$w]
2574 pack
$w.buttons.cancel
-side right
-padx 5
2575 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2577 labelframe
$w.
source \
2578 -text {Source Branches
} \
2580 listbox
$w.
source.l \
2583 -selectmode extended \
2584 -yscrollcommand [list
$w.
source.sby
set] \
2586 foreach h
$all_heads {
2587 $w.
source.l insert end
$h
2588 if {$h eq
$current_branch} {
2589 $w.
source.l
select set end
2592 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2593 pack
$w.
source.sby
-side right
-fill y
2594 pack
$w.
source.l
-side left
-fill both
-expand 1
2595 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2597 labelframe
$w.dest \
2598 -text {Destination Repository
} \
2600 if {$all_remotes ne
{}} {
2601 radiobutton
$w.dest.remote_r \
2604 -variable push_urltype \
2606 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2607 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2608 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2609 set push_remote origin
2611 set push_remote
[lindex
$all_remotes 0]
2613 set push_urltype remote
2615 set push_urltype url
2617 radiobutton
$w.dest.url_r \
2618 -text {Arbitrary URL
:} \
2620 -variable push_urltype \
2622 entry
$w.dest.url_t \
2626 -textvariable push_url \
2630 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2631 if {%d
== 1 && [string length
%S
] > 0} {
2632 set push_urltype url
2636 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2637 grid columnconfigure
$w.dest
1 -weight 1
2638 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2640 labelframe
$w.options \
2641 -text {Transfer Options
} \
2643 checkbutton
$w.options.thin \
2644 -text {Use thin pack
(for slow network connections
)} \
2645 -variable push_thin \
2647 grid
$w.options.thin
-columnspan 2 -sticky w
2648 checkbutton
$w.options.tags \
2649 -text {Include tags
} \
2650 -variable push_tags \
2652 grid
$w.options.tags
-columnspan 2 -sticky w
2653 grid columnconfigure
$w.options
1 -weight 1
2654 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2660 bind $w <Visibility
> "grab $w"
2661 bind $w <Key-Escape
> "destroy $w"
2662 wm title
$w "[appname] ([reponame]): Push"
2666 ######################################################################
2671 global HEAD commit_type file_states
2673 if {[string match amend
* $commit_type]} {
2674 info_popup
{Cannot merge
while amending.
2676 You must finish amending this commit before
2677 starting any
type of merge.
2682 if {[committer_ident
] eq
{}} {return 0}
2683 if {![lock_index merge
]} {return 0}
2685 # -- Our in memory state should match the repository.
2687 repository_state curType curHEAD curMERGE_HEAD
2688 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2689 info_popup
{Last scanned state does not match repository state.
2691 Another Git program has modified this repository
2692 since the last scan. A rescan must be performed
2693 before a merge can be performed.
2695 The rescan will be automatically started now.
2698 rescan
{set ui_status_value
{Ready.
}}
2702 foreach path
[array names file_states
] {
2703 switch
-glob -- [lindex
$file_states($path) 0] {
2705 continue; # and pray it works!
2708 error_popup
"You are in the middle of a conflicted merge.
2710 File [short_path $path] has merge conflicts.
2712 You must resolve them, add the file, and commit to
2713 complete the current merge. Only then can you
2714 begin another merge.
2720 error_popup
"You are in the middle of a change.
2722 File [short_path $path] is modified.
2724 You should complete the current commit before
2725 starting a merge. Doing so will help you abort
2726 a failed merge, should the need arise.
2737 proc visualize_local_merge
{w
} {
2739 foreach i
[$w.
source.l curselection
] {
2740 lappend revs
[$w.
source.l get
$i]
2742 if {$revs eq
{}} return
2743 lappend revs
--not HEAD
2747 proc start_local_merge_action
{w
} {
2748 global HEAD ui_status_value current_branch
2750 set cmd
[list git merge
]
2753 foreach i
[$w.
source.l curselection
] {
2754 set b
[$w.
source.l get
$i]
2762 } elseif
{$revcnt == 1} {
2764 } elseif
{$revcnt <= 15} {
2770 -title [wm title
$w] \
2772 -message "Too many branches selected.
2774 You have requested to merge $revcnt branches
2775 in an octopus merge. This exceeds Git's
2776 internal limit of 15 branches per merge.
2778 Please select fewer branches. To merge more
2779 than 15 branches, merge the branches in batches.
2784 set msg
"Merging $current_branch, [join $names {, }]"
2785 set ui_status_value
"$msg..."
2786 set cons
[new_console
"Merge" $msg]
2787 console_exec
$cons $cmd [list finish_merge
$revcnt]
2788 bind $w <Destroy
> {}
2792 proc finish_merge
{revcnt w ok
} {
2795 set msg
{Merge completed successfully.
}
2798 info_popup
"Octopus merge failed.
2800 Your merge of $revcnt branches has failed.
2802 There are file-level conflicts between the
2803 branches which must be resolved manually.
2805 The working directory will now be reset.
2807 You can attempt this merge again
2808 by merging only one branch at a time." $w
2810 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2811 fconfigure
$fd -blocking 0 -translation binary
2812 fileevent
$fd readable
[list reset_hard_wait
$fd]
2813 set ui_status_value
{Aborting... please
wait...
}
2817 set msg
{Merge failed. Conflict resolution is required.
}
2820 rescan
[list
set ui_status_value
$msg]
2823 proc do_local_merge
{} {
2824 global current_branch
2826 if {![can_merge
]} return
2830 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2833 -text "Merge Into $current_branch" \
2835 pack
$w.header
-side top
-fill x
2838 button
$w.buttons.visualize
-text Visualize \
2840 -command [list visualize_local_merge
$w]
2841 pack
$w.buttons.visualize
-side left
2842 button
$w.buttons.create
-text Merge \
2844 -command [list start_local_merge_action
$w]
2845 pack
$w.buttons.create
-side right
2846 button
$w.buttons.cancel
-text {Cancel
} \
2848 -command [list destroy
$w]
2849 pack
$w.buttons.cancel
-side right
-padx 5
2850 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2852 labelframe
$w.
source \
2853 -text {Source Branches
} \
2855 listbox
$w.
source.l \
2858 -selectmode extended \
2859 -yscrollcommand [list
$w.
source.sby
set] \
2861 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2862 pack
$w.
source.sby
-side right
-fill y
2863 pack
$w.
source.l
-side left
-fill both
-expand 1
2864 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2866 set cmd
[list git for-each-ref
]
2867 lappend cmd
{--format=%(objectname
) %(refname
)}
2868 lappend cmd refs
/heads
2869 lappend cmd refs
/remotes
2870 set fr_fd
[open
"| $cmd" r
]
2871 fconfigure
$fr_fd -translation binary
2872 while {[gets
$fr_fd line
] > 0} {
2873 set line
[split $line { }]
2874 set sha1
([lindex
$line 0]) [lindex
$line 1]
2879 set fr_fd
[open
"| git rev-list --all --not HEAD"]
2880 while {[gets
$fr_fd line
] > 0} {
2881 if {[catch
{set ref
$sha1($line)}]} continue
2882 regsub ^refs
/(heads|remotes
)/ $ref {} ref
2883 lappend to_show
$ref
2887 foreach ref
[lsort
-unique $to_show] {
2888 $w.
source.l insert end
$ref
2891 bind $w <Visibility
> "grab $w"
2892 bind $w <Key-Escape
> "unlock_index;destroy $w"
2893 bind $w <Destroy
> unlock_index
2894 wm title
$w "[appname] ([reponame]): Merge"
2898 proc do_reset_hard
{} {
2899 global HEAD commit_type file_states
2901 if {[string match amend
* $commit_type]} {
2902 info_popup
{Cannot abort
while amending.
2904 You must finish amending this commit.
2909 if {![lock_index abort
]} return
2911 if {[string match
*merge
* $commit_type]} {
2917 if {[ask_popup
"Abort $op?
2919 Aborting the current $op will cause
2920 *ALL* uncommitted changes to be lost.
2922 Continue with aborting the current $op?"] eq
{yes}} {
2923 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2924 fconfigure
$fd -blocking 0 -translation binary
2925 fileevent
$fd readable
[list reset_hard_wait
$fd]
2926 set ui_status_value
{Aborting... please
wait...
}
2932 proc reset_hard_wait
{fd
} {
2940 $ui_comm delete
0.0 end
2941 $ui_comm edit modified false
2943 catch
{file delete
[gitdir MERGE_HEAD
]}
2944 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
2945 catch
{file delete
[gitdir SQUASH_MSG
]}
2946 catch
{file delete
[gitdir MERGE_MSG
]}
2947 catch
{file delete
[gitdir GITGUI_MSG
]}
2949 rescan
{set ui_status_value
{Abort completed. Ready.
}}
2953 ######################################################################
2957 set next_browser_id
0
2959 proc new_browser
{commit
} {
2960 global next_browser_id cursor_ptr
2961 global browser_commit browser_status browser_stack browser_path browser_busy
2963 set w .browser
[incr next_browser_id
]
2964 set w_list
$w.list.l
2965 set browser_commit
($w_list) $commit
2966 set browser_status
($w_list) {Starting...
}
2967 set browser_stack
($w_list) {}
2968 set browser_path
($w_list) $browser_commit($w_list):
2969 set browser_busy
($w_list) 1
2972 label
$w.path
-textvariable browser_path
($w_list) \
2978 pack
$w.path
-anchor w
-side top
-fill x
2981 text
$w_list -background white
-borderwidth 0 \
2982 -cursor $cursor_ptr \
2987 -xscrollcommand [list
$w.list.sbx
set] \
2988 -yscrollcommand [list
$w.list.sby
set] \
2990 $w_list tag conf in_sel \
2991 -background [$w_list cget
-foreground] \
2992 -foreground [$w_list cget
-background]
2993 scrollbar
$w.list.sbx
-orient h
-command [list
$w_list xview
]
2994 scrollbar
$w.list.sby
-orient v
-command [list
$w_list yview
]
2995 pack
$w.list.sbx
-side bottom
-fill x
2996 pack
$w.list.sby
-side right
-fill y
2997 pack
$w_list -side left
-fill both
-expand 1
2998 pack
$w.list
-side top
-fill both
-expand 1
3000 label
$w.status
-textvariable browser_status
($w_list) \
3006 pack
$w.status
-anchor w
-side bottom
-fill x
3008 bind $w_list <Button-1
> "browser_click 0 $w_list @%x,%y;break"
3009 bind $w_list <Double-Button-1
> "browser_click 1 $w_list @%x,%y;break"
3011 bind $w <Visibility
> "focus $w"
3013 array unset browser_buffer $w_list
3014 array unset browser_files $w_list
3015 array unset browser_status $w_list
3016 array unset browser_stack $w_list
3017 array unset browser_path $w_list
3018 array unset browser_commit $w_list
3019 array unset browser_busy $w_list
3021 wm title
$w "[appname] ([reponame]): File Browser"
3022 ls_tree
$w_list $browser_commit($w_list) {}
3025 proc browser_click
{was_double_click w pos
} {
3026 global browser_files browser_status browser_path
3027 global browser_commit browser_stack browser_busy
3029 if {$browser_busy($w)} return
3030 set lno
[lindex
[split [$w index
$pos] .
] 0]
3031 set info
[lindex
$browser_files($w) [expr {$lno - 1}]]
3033 $w conf
-state normal
3034 $w tag remove sel
0.0 end
3035 $w tag remove in_sel
0.0 end
3037 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3038 if {$was_double_click} {
3039 switch
-- [lindex
$info 0] {
3041 set parent
[lindex
$browser_stack($w) end-1
]
3042 set browser_stack
($w) [lrange
$browser_stack($w) 0 end-2
]
3043 if {$browser_stack($w) eq
{}} {
3044 regsub
{:.
*$
} $browser_path($w) {:} browser_path
($w)
3046 regsub
{/[^
/]+$
} $browser_path($w) {} browser_path
($w)
3048 set browser_status
($w) "Loading $browser_path($w)..."
3049 ls_tree
$w [lindex
$parent 0] [lindex
$parent 1]
3052 set name
[lindex
$info 2]
3053 set escn
[escape_path
$name]
3054 set browser_status
($w) "Loading $escn..."
3055 append browser_path
($w) $escn
3056 ls_tree
$w [lindex
$info 1] $name
3059 set name
[lindex
$info 2]
3061 foreach n
$browser_stack($w) {
3062 append p
[lindex
$n 1]
3065 show_blame
$browser_commit($w) $p
3070 $w conf
-state disabled
3073 proc ls_tree
{w tree_id name
} {
3074 global browser_buffer browser_files browser_stack browser_busy
3076 set browser_buffer
($w) {}
3077 set browser_files
($w) {}
3078 set browser_busy
($w) 1
3080 $w conf
-state normal
3081 $w tag remove in_sel
0.0 end
3082 $w tag remove sel
0.0 end
3084 if {$browser_stack($w) ne
{}} {
3085 $w image create end \
3086 -align center
-padx 5 -pady 1 \
3089 $w insert end
{[Up To Parent
]}
3090 lappend browser_files
($w) parent
3092 lappend browser_stack
($w) [list
$tree_id $name]
3093 $w conf
-state disabled
3095 set cmd
[list git ls-tree
-z $tree_id]
3096 set fd
[open
"| $cmd" r
]
3097 fconfigure
$fd -blocking 0 -translation binary
-encoding binary
3098 fileevent
$fd readable
[list read_ls_tree
$fd $w]
3101 proc read_ls_tree
{fd w
} {
3102 global browser_buffer browser_files browser_status browser_busy
3104 if {![winfo exists
$w]} {
3109 append browser_buffer
($w) [read $fd]
3110 set pck
[split $browser_buffer($w) "\0"]
3111 set browser_buffer
($w) [lindex
$pck end
]
3113 set n
[llength
$browser_files($w)]
3114 $w conf
-state normal
3115 foreach p
[lrange
$pck 0 end-1
] {
3116 set info
[split $p "\t"]
3117 set path
[lindex
$info 1]
3118 set info
[split [lindex
$info 0] { }]
3119 set type [lindex
$info 1]
3120 set object
[lindex
$info 2]
3131 set image file_question
3135 if {$n > 0} {$w insert end
"\n"}
3136 $w image create end \
3137 -align center
-padx 5 -pady 1 \
3138 -name icon
[incr n
] \
3140 $w insert end
[escape_path
$path]
3141 lappend browser_files
($w) [list
$type $object $path]
3143 $w conf
-state disabled
3147 set browser_status
($w) Ready.
3148 set browser_busy
($w) 0
3149 array
unset browser_buffer
$w
3153 proc show_blame
{commit path
} {
3154 global next_browser_id blame_status blame_data
3156 set w .browser
[incr next_browser_id
]
3157 set blame_status
($w) {Loading current
file content...
}
3162 label
$w.path
-text "$commit:$path" \
3168 pack
$w.path
-side top
-fill x
3172 label
$w.out.commit_l
-text Commit \
3177 text
$w.out.commit_t \
3178 -background white
-borderwidth 0 \
3184 lappend texts
$w.out.commit_t
3186 label
$w.out.author_l
-text Author \
3191 text
$w.out.author_t \
3192 -background white
-borderwidth 0 \
3198 lappend texts
$w.out.author_t
3200 label
$w.out.date_l
-text Date \
3205 text
$w.out.date_t \
3206 -background white
-borderwidth 0 \
3210 -width [string length
"yyyy-mm-dd hh:mm:ss"] \
3212 lappend texts
$w.out.date_t
3214 label
$w.out.filename_l
-text Filename \
3219 text
$w.out.filename_t \
3220 -background white
-borderwidth 0 \
3226 lappend texts
$w.out.filename_t
3228 label
$w.out.origlinenumber_l
-text {Orig Line
} \
3233 text
$w.out.origlinenumber_t \
3234 -background white
-borderwidth 0 \
3240 $w.out.origlinenumber_t tag conf linenumber
-justify right
3241 lappend texts
$w.out.origlinenumber_t
3243 label
$w.out.linenumber_l
-text {Curr Line
} \
3248 text
$w.out.linenumber_t \
3249 -background white
-borderwidth 0 \
3255 $w.out.linenumber_t tag conf linenumber
-justify right
3256 lappend texts
$w.out.linenumber_t
3258 label
$w.out.file_l
-text {File Content
} \
3263 text
$w.out.file_t \
3264 -background white
-borderwidth 0 \
3269 -xscrollcommand [list
$w.out.sbx
set] \
3271 lappend texts
$w.out.file_t
3273 scrollbar
$w.out.sbx
-orient h
-command [list
$w.out.file_t xview
]
3274 scrollbar
$w.out.sby
-orient v \
3275 -command [list scrollbar2many
$texts yview
]
3278 regsub
{_t$
} $i _l l
3281 set file_col
[expr {[llength
$texts] - 1}]
3282 eval grid
$labels -sticky we
3283 eval grid
$texts $w.out.sby
-sticky nsew
3284 grid conf
$w.out.sbx
-column $file_col -sticky we
3285 grid columnconfigure
$w.out
$file_col -weight 1
3286 grid rowconfigure
$w.out
1 -weight 1
3287 pack
$w.out
-fill both
-expand 1
3289 label
$w.status
-textvariable blame_status
($w) \
3295 pack
$w.status
-side bottom
-fill x
3297 menu
$w.ctxm
-tearoff 0
3298 $w.ctxm add
command -label "Copy Commit" \
3300 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3303 $i tag conf in_sel \
3304 -background [$i cget
-foreground] \
3305 -foreground [$i cget
-background]
3306 $i conf
-yscrollcommand \
3307 [list many2scrollbar
$texts yview
$w.out.sby
]
3308 bind $i <Button-1
> "blame_highlight $i @%x,%y $texts;break"
3313 tk_popup $w.ctxm %X %Y
3317 set blame_data
($w,colors
) {}
3319 bind $w <Visibility
> "focus $w"
3321 array unset blame_status $w
3322 array unset blame_data $w,*
3324 wm title
$w "[appname] ([reponame]): File Viewer"
3326 set blame_data
($w,total_lines
) 0
3327 set cmd
[list git cat-file blob
"$commit:$path"]
3328 set fd
[open
"| $cmd" r
]
3329 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3330 fileevent
$fd readable
[list read_blame_catfile \
3331 $fd $w $commit $path \
3332 $texts $w.out.linenumber_t
$w.out.file_t
]
3335 proc read_blame_catfile
{fd w commit path texts w_lno w_file
} {
3336 global blame_status blame_data
3338 if {![winfo exists
$w_file]} {
3343 set n
$blame_data($w,total_lines
)
3344 foreach i
$texts {$i conf
-state normal
}
3345 while {[gets
$fd line
] >= 0} {
3346 regsub
"\r\$" $line {} line
3348 $w_lno insert end
$n linenumber
3349 $w_file insert end
$line
3350 foreach i
$texts {$i insert end
"\n"}
3352 foreach i
$texts {$i conf
-state disabled
}
3353 set blame_data
($w,total_lines
) $n
3357 set blame_status
($w) {Loading annotations...
}
3358 set cmd
[list git blame
-M -C --incremental]
3359 lappend cmd
$commit -- $path
3360 set fd
[open
"| $cmd" r
]
3361 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3362 fileevent
$fd readable
"read_blame_incremental $fd $w $texts"
3366 proc read_blame_incremental
{fd w
3367 w_commit w_author w_date w_filename w_olno
3369 global blame_status blame_data
3371 if {![winfo exists
$w_commit]} {
3385 $w_commit conf
-state normal
3386 $w_author conf
-state normal
3387 $w_date conf
-state normal
3388 $w_filename conf
-state normal
3389 $w_olno conf
-state normal
3391 while {[gets
$fd line
] >= 0} {
3392 if {[regexp
{^
([a-z0-9
]{40}) (\d
+) (\d
+) (\d
+)$
} $line line \
3393 cmit original_line final_line line_count
]} {
3394 set blame_data
($w,commit
) $cmit
3395 set blame_data
($w,original_line
) $original_line
3396 set blame_data
($w,final_line
) $final_line
3397 set blame_data
($w,line_count
) $line_count
3399 if {[catch
{set g
$blame_data($w,$cmit,seen
)}]} {
3400 if {$blame_data($w,colors
) eq
{}} {
3401 set blame_data
($w,colors
) {
3410 set c
[lindex
$blame_data($w,colors
) 0]
3411 set blame_data
($w,colors
) \
3412 [lrange
$blame_data($w,colors
) 1 end
]
3414 $t tag conf g
$cmit -background $c
3417 set blame_data
($w,$cmit,seen
) 1
3419 } elseif
{[string match
{filename
*} $line]} {
3420 set n
$blame_data($w,line_count
)
3421 set lno
$blame_data($w,final_line
)
3422 set ol
$blame_data($w,original_line
)
3423 set file [string range
$line 9 end
]
3424 set cmit
$blame_data($w,commit
)
3425 set abbrev
[string range
$cmit 0 8]
3427 if {[catch
{set author
$blame_data($w,$cmit,author
)} err
]} {
3431 if {[catch
{set atime
$blame_data($w,$cmit,author-time
)}]} {
3434 set atime
[clock format
$atime -format {%Y-
%m-
%d
%T
}]
3438 if {![catch
{set g g
$blame_data($w,line
$lno,commit
)}]} {
3440 $t tag remove
$g $lno.0 "$lno.0 lineend + 1c"
3450 $t delete
$lno.0 "$lno.0 lineend"
3453 $w_commit insert
$lno.0 $abbrev
3454 $w_author insert
$lno.0 $author
3455 $w_date insert
$lno.0 $atime
3456 $w_filename insert
$lno.0 $file
3457 $w_olno insert
$lno.0 $ol linenumber
3461 $t tag add
$g $lno.0 "$lno.0 lineend + 1c"
3464 set blame_data
($w,line
$lno,commit
) $cmit
3470 } elseif
{[regexp
{^
([a-z-
]+) (.
*)$
} $line line header data
]} {
3471 set blame_data
($w,$blame_data($w,commit
),$header) $data
3475 $w_commit conf
-state disabled
3476 $w_author conf
-state disabled
3477 $w_date conf
-state disabled
3478 $w_filename conf
-state disabled
3479 $w_olno conf
-state disabled
3483 set blame_status
($w) {Annotation complete.
}
3487 proc blame_highlight
{w pos args
} {
3488 set lno
[lindex
[split [$w index
$pos] .
] 0]
3490 $i tag remove in_sel
0.0 end
3492 if {$lno eq
{}} return
3494 $i tag add in_sel
$lno.0 "$lno.0 + 1 line"
3498 proc blame_copycommit
{w i pos
} {
3500 set lno
[lindex
[split [$i index
$pos] .
] 0]
3501 if {![catch
{set commit
$blame_data($w,line
$lno,commit
)}]} {
3510 ######################################################################
3515 #define mask_width 14
3516 #define mask_height 15
3517 static unsigned char mask_bits
[] = {
3518 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3519 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3520 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3523 image create bitmap file_plain
-background white
-foreground black
-data {
3524 #define plain_width 14
3525 #define plain_height 15
3526 static unsigned char plain_bits
[] = {
3527 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3528 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3529 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3530 } -maskdata $filemask
3532 image create bitmap file_mod
-background white
-foreground blue
-data {
3533 #define mod_width 14
3534 #define mod_height 15
3535 static unsigned char mod_bits
[] = {
3536 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3537 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3538 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3539 } -maskdata $filemask
3541 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
3542 #define file_fulltick_width 14
3543 #define file_fulltick_height 15
3544 static unsigned char file_fulltick_bits
[] = {
3545 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3546 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3547 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3548 } -maskdata $filemask
3550 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
3551 #define parttick_width 14
3552 #define parttick_height 15
3553 static unsigned char parttick_bits
[] = {
3554 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3555 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3556 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3557 } -maskdata $filemask
3559 image create bitmap file_question
-background white
-foreground black
-data {
3560 #define file_question_width 14
3561 #define file_question_height 15
3562 static unsigned char file_question_bits
[] = {
3563 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3564 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3565 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3566 } -maskdata $filemask
3568 image create bitmap file_removed
-background white
-foreground red
-data {
3569 #define file_removed_width 14
3570 #define file_removed_height 15
3571 static unsigned char file_removed_bits
[] = {
3572 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3573 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3574 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3575 } -maskdata $filemask
3577 image create bitmap file_merge
-background white
-foreground blue
-data {
3578 #define file_merge_width 14
3579 #define file_merge_height 15
3580 static unsigned char file_merge_bits
[] = {
3581 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3582 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3583 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3584 } -maskdata $filemask
3587 #define file_width 18
3588 #define file_height 18
3589 static unsigned char file_bits
[] = {
3590 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3591 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3592 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3593 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3594 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3596 image create bitmap file_dir
-background white
-foreground blue \
3597 -data $file_dir_data -maskdata $file_dir_data
3600 set file_uplevel_data
{
3602 #define up_height 15
3603 static unsigned char up_bits
[] = {
3604 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3605 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3606 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3608 image create bitmap file_uplevel
-background white
-foreground red \
3609 -data $file_uplevel_data -maskdata $file_uplevel_data
3610 unset file_uplevel_data
3612 set ui_index .vpane.files.index.list
3613 set ui_workdir .vpane.files.workdir.list
3615 set all_icons
(_
$ui_index) file_plain
3616 set all_icons
(A
$ui_index) file_fulltick
3617 set all_icons
(M
$ui_index) file_fulltick
3618 set all_icons
(D
$ui_index) file_removed
3619 set all_icons
(U
$ui_index) file_merge
3621 set all_icons
(_
$ui_workdir) file_plain
3622 set all_icons
(M
$ui_workdir) file_mod
3623 set all_icons
(D
$ui_workdir) file_question
3624 set all_icons
(U
$ui_workdir) file_merge
3625 set all_icons
(O
$ui_workdir) file_plain
3627 set max_status_desc
0
3631 {_M
"Modified, not staged"}
3632 {M_
"Staged for commit"}
3633 {MM
"Portions staged for commit"}
3634 {MD
"Staged for commit, missing"}
3636 {_O
"Untracked, not staged"}
3637 {A_
"Staged for commit"}
3638 {AM
"Portions staged for commit"}
3639 {AD
"Staged for commit, missing"}
3642 {D_
"Staged for removal"}
3643 {DO
"Staged for removal, still present"}
3645 {U_
"Requires merge resolution"}
3646 {UU
"Requires merge resolution"}
3647 {UM
"Requires merge resolution"}
3648 {UD
"Requires merge resolution"}
3650 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3651 set max_status_desc
[string length
[lindex
$i 1]]
3653 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3657 ######################################################################
3661 proc bind_button3
{w cmd
} {
3662 bind $w <Any-Button-3
> $cmd
3664 bind $w <Control-Button-1
> $cmd
3668 proc scrollbar2many
{list mode args
} {
3669 foreach w
$list {eval $w $mode $args}
3672 proc many2scrollbar
{list mode sb top bottom
} {
3673 $sb set $top $bottom
3674 foreach w
$list {$w $mode moveto
$top}
3677 proc incr_font_size
{font
{amt
1}} {
3678 set sz
[font configure
$font -size]
3680 font configure
$font -size $sz
3681 font configure
${font}bold
-size $sz
3684 proc hook_failed_popup
{hook msg
} {
3689 label
$w.m.l1
-text "$hook hook failed:" \
3694 -background white
-borderwidth 1 \
3696 -width 80 -height 10 \
3698 -yscrollcommand [list
$w.m.sby
set]
3700 -text {You must correct the above errors before committing.
} \
3704 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3705 pack
$w.m.l1
-side top
-fill x
3706 pack
$w.m.l2
-side bottom
-fill x
3707 pack
$w.m.sby
-side right
-fill y
3708 pack
$w.m.t
-side left
-fill both
-expand 1
3709 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3711 $w.m.t insert
1.0 $msg
3712 $w.m.t conf
-state disabled
3714 button
$w.ok
-text OK \
3717 -command "destroy $w"
3718 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3720 bind $w <Visibility
> "grab $w; focus $w"
3721 bind $w <Key-Return
> "destroy $w"
3722 wm title
$w "[appname] ([reponame]): error"
3726 set next_console_id
0
3728 proc new_console
{short_title long_title
} {
3729 global next_console_id console_data
3730 set w .console
[incr next_console_id
]
3731 set console_data
($w) [list
$short_title $long_title]
3732 return [console_init
$w]
3735 proc console_init
{w
} {
3736 global console_cr console_data M1B
3738 set console_cr
($w) 1.0
3741 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3746 -background white
-borderwidth 1 \
3748 -width 80 -height 10 \
3751 -yscrollcommand [list
$w.m.sby
set]
3752 label
$w.m.s
-text {Working... please
wait...
} \
3756 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3757 pack
$w.m.l1
-side top
-fill x
3758 pack
$w.m.s
-side bottom
-fill x
3759 pack
$w.m.sby
-side right
-fill y
3760 pack
$w.m.t
-side left
-fill both
-expand 1
3761 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3763 menu
$w.ctxm
-tearoff 0
3764 $w.ctxm add
command -label "Copy" \
3766 -command "tk_textCopy $w.m.t"
3767 $w.ctxm add
command -label "Select All" \
3769 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3770 $w.ctxm add
command -label "Copy All" \
3773 $w.m.t tag add sel 0.0 end
3775 $w.m.t tag remove sel 0.0 end
3778 button
$w.ok
-text {Close
} \
3781 -command "destroy $w"
3782 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3784 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
3785 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3786 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3787 bind $w <Visibility
> "focus $w"
3788 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3792 proc console_exec
{w cmd after
} {
3793 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3794 # But most users need that so we have to relogin. :-(
3797 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
3800 # -- Tcl won't let us redirect both stdout and stderr to
3801 # the same pipe. So pass it through cat...
3803 set cmd
[concat |
$cmd |
& cat]
3805 set fd_f
[open
$cmd r
]
3806 fconfigure
$fd_f -blocking 0 -translation binary
3807 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
3810 proc console_read
{w fd after
} {
3815 if {![winfo exists
$w]} {console_init
$w}
3816 $w.m.t conf
-state normal
3818 set n
[string length
$buf]
3820 set cr
[string first
"\r" $buf $c]
3821 set lf
[string first
"\n" $buf $c]
3822 if {$cr < 0} {set cr
[expr {$n + 1}]}
3823 if {$lf < 0} {set lf
[expr {$n + 1}]}
3826 $w.m.t insert end
[string range
$buf $c $lf]
3827 set console_cr
($w) [$w.m.t index
{end
-1c}]
3831 $w.m.t delete
$console_cr($w) end
3832 $w.m.t insert end
"\n"
3833 $w.m.t insert end
[string range
$buf $c $cr]
3838 $w.m.t conf
-state disabled
3842 fconfigure
$fd -blocking 1
3844 if {[catch
{close
$fd}]} {
3849 uplevel
#0 $after $w $ok
3852 fconfigure
$fd -blocking 0
3855 proc console_chain
{cmdlist w
{ok
1}} {
3857 if {[llength
$cmdlist] == 0} {
3862 set cmd
[lindex
$cmdlist 0]
3863 set cmdlist
[lrange
$cmdlist 1 end
]
3865 if {[lindex
$cmd 0] eq
{console_exec
}} {
3868 [list console_chain
$cmdlist]
3870 uplevel
#0 $cmd $cmdlist $w $ok
3877 proc console_done
{args
} {
3878 global console_cr console_data
3880 switch
-- [llength
$args] {
3882 set w
[lindex
$args 0]
3883 set ok
[lindex
$args 1]
3886 set w
[lindex
$args 1]
3887 set ok
[lindex
$args 2]
3890 error
"wrong number of args: console_done ?ignored? w ok"
3895 if {[winfo exists
$w]} {
3896 $w.m.s conf
-background green
-text {Success
}
3897 $w.ok conf
-state normal
3900 if {![winfo exists
$w]} {
3903 $w.m.s conf
-background red
-text {Error
: Command Failed
}
3904 $w.ok conf
-state normal
3907 array
unset console_cr
$w
3908 array
unset console_data
$w
3911 ######################################################################
3915 set starting_gitk_msg
{Starting gitk... please
wait...
}
3917 proc do_gitk
{revs
} {
3918 global env ui_status_value starting_gitk_msg
3920 # -- On Windows gitk is severly broken, and right now it seems like
3921 # nobody cares about fixing it. The only known workaround is to
3922 # always delete ~/.gitk before starting the program.
3925 catch
{file delete
[file join $env(HOME
) .gitk
]}
3928 # -- Always start gitk through whatever we were loaded with. This
3929 # lets us bypass using shell process on Windows systems.
3931 set cmd
[info nameofexecutable
]
3932 lappend cmd
[gitexec gitk
]
3938 if {[catch
{eval exec $cmd &} err
]} {
3939 error_popup
"Failed to start gitk:\n\n$err"
3941 set ui_status_value
$starting_gitk_msg
3943 if {$ui_status_value eq
$starting_gitk_msg} {
3944 set ui_status_value
{Ready.
}
3951 set fd
[open
"| git count-objects -v" r
]
3952 while {[gets
$fd line
] > 0} {
3953 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
3954 set stats
($name) $value
3960 foreach p
[glob
-directory [gitdir objects pack
] \
3963 incr packed_sz
[file size
$p]
3965 if {$packed_sz > 0} {
3966 set stats
(size-pack
) [expr {$packed_sz / 1024}]
3971 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3973 label
$w.header
-text {Database Statistics
} \
3975 pack
$w.header
-side top
-fill x
3977 frame
$w.buttons
-border 1
3978 button
$w.buttons.close
-text Close \
3980 -command [list destroy
$w]
3981 button
$w.buttons.gc
-text {Compress Database
} \
3983 -command "destroy $w;do_gc"
3984 pack
$w.buttons.close
-side right
3985 pack
$w.buttons.gc
-side left
3986 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3988 frame
$w.stat
-borderwidth 1 -relief solid
3990 {count
{Number of loose objects
}}
3991 {size
{Disk space used by loose objects
} { KiB
}}
3992 {in-pack
{Number of packed objects
}}
3993 {packs
{Number of packs
}}
3994 {size-pack
{Disk space used by packed objects
} { KiB
}}
3995 {prune-packable
{Packed objects waiting
for pruning
}}
3996 {garbage
{Garbage files
}}
3998 set name
[lindex
$s 0]
3999 set label
[lindex
$s 1]
4000 if {[catch
{set value
$stats($name)}]} continue
4001 if {[llength
$s] > 2} {
4002 set value
"$value[lindex $s 2]"
4005 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
4006 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
4007 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
4009 pack
$w.stat
-pady 10 -padx 10
4011 bind $w <Visibility
> "grab $w; focus $w"
4012 bind $w <Key-Escape
> [list destroy
$w]
4013 bind $w <Key-Return
> [list destroy
$w]
4014 wm title
$w "[appname] ([reponame]): Database Statistics"
4019 set w
[new_console
{gc
} {Compressing the object database
}]
4021 {console_exec
{git pack-refs
--prune}}
4022 {console_exec
{git reflog expire
--all}}
4023 {console_exec
{git repack
-a -d -l}}
4024 {console_exec
{git rerere gc
}}
4028 proc do_fsck_objects
{} {
4029 set w
[new_console
{fsck-objects
} \
4030 {Verifying the object database with fsck-objects
}]
4031 set cmd
[list git fsck-objects
]
4034 lappend cmd
--strict
4035 console_exec
$w $cmd console_done
4041 global ui_comm is_quitting repo_config commit_type
4043 if {$is_quitting} return
4046 # -- Stash our current commit buffer.
4048 set save
[gitdir GITGUI_MSG
]
4049 set msg
[string trim
[$ui_comm get
0.0 end
]]
4050 regsub
-all -line {[ \r\t]+$
} $msg {} msg
4051 if {(![string match amend
* $commit_type]
4052 ||
[$ui_comm edit modified
])
4055 set fd
[open
$save w
]
4056 puts
-nonewline $fd $msg
4060 catch
{file delete
$save}
4063 # -- Stash our current window geometry into this repository.
4065 set cfg_geometry
[list
]
4066 lappend cfg_geometry
[wm geometry .
]
4067 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
4068 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
4069 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
4072 if {$cfg_geometry ne
$rc_geometry} {
4073 catch
{exec git repo-config gui.geometry
$cfg_geometry}
4080 rescan
{set ui_status_value
{Ready.
}}
4083 proc unstage_helper
{txt paths
} {
4084 global file_states current_diff_path
4086 if {![lock_index begin-update
]} return
4090 foreach path
$paths {
4091 switch
-glob -- [lindex
$file_states($path) 0] {
4095 lappend pathList
$path
4096 if {$path eq
$current_diff_path} {
4097 set after
{reshow_diff
;}
4102 if {$pathList eq
{}} {
4108 [concat
$after {set ui_status_value
{Ready.
}}]
4112 proc do_unstage_selection
{} {
4113 global current_diff_path selected_paths
4115 if {[array size selected_paths
] > 0} {
4117 {Unstaging selected files from commit
} \
4118 [array names selected_paths
]
4119 } elseif
{$current_diff_path ne
{}} {
4121 "Unstaging [short_path $current_diff_path] from commit" \
4122 [list
$current_diff_path]
4126 proc add_helper
{txt paths
} {
4127 global file_states current_diff_path
4129 if {![lock_index begin-update
]} return
4133 foreach path
$paths {
4134 switch
-glob -- [lindex
$file_states($path) 0] {
4139 lappend pathList
$path
4140 if {$path eq
$current_diff_path} {
4141 set after
{reshow_diff
;}
4146 if {$pathList eq
{}} {
4152 [concat
$after {set ui_status_value
{Ready to commit.
}}]
4156 proc do_add_selection
{} {
4157 global current_diff_path selected_paths
4159 if {[array size selected_paths
] > 0} {
4161 {Adding selected files
} \
4162 [array names selected_paths
]
4163 } elseif
{$current_diff_path ne
{}} {
4165 "Adding [short_path $current_diff_path]" \
4166 [list
$current_diff_path]
4170 proc do_add_all
{} {
4174 foreach path
[array names file_states
] {
4175 switch
-glob -- [lindex
$file_states($path) 0] {
4178 ?D
{lappend paths
$path}
4181 add_helper
{Adding all changed files
} $paths
4184 proc revert_helper
{txt paths
} {
4185 global file_states current_diff_path
4187 if {![lock_index begin-update
]} return
4191 foreach path
$paths {
4192 switch
-glob -- [lindex
$file_states($path) 0] {
4196 lappend pathList
$path
4197 if {$path eq
$current_diff_path} {
4198 set after
{reshow_diff
;}
4204 set n
[llength
$pathList]
4208 } elseif
{$n == 1} {
4209 set s
"[short_path [lindex $pathList]]"
4211 set s
"these $n files"
4214 set reply
[tk_dialog \
4216 "[appname] ([reponame])" \
4217 "Revert changes in $s?
4219 Any unadded changes will be permanently lost by the revert." \
4229 [concat
$after {set ui_status_value
{Ready.
}}]
4235 proc do_revert_selection
{} {
4236 global current_diff_path selected_paths
4238 if {[array size selected_paths
] > 0} {
4240 {Reverting selected files
} \
4241 [array names selected_paths
]
4242 } elseif
{$current_diff_path ne
{}} {
4244 "Reverting [short_path $current_diff_path]" \
4245 [list
$current_diff_path]
4249 proc do_signoff
{} {
4252 set me
[committer_ident
]
4253 if {$me eq
{}} return
4255 set sob
"Signed-off-by: $me"
4256 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
4257 if {$last ne
$sob} {
4258 $ui_comm edit separator
4260 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
4261 $ui_comm insert end
"\n"
4263 $ui_comm insert end
"\n$sob"
4264 $ui_comm edit separator
4269 proc do_select_commit_type
{} {
4270 global commit_type selected_commit_type
4272 if {$selected_commit_type eq
{new
}
4273 && [string match amend
* $commit_type]} {
4275 } elseif
{$selected_commit_type eq
{amend
}
4276 && ![string match amend
* $commit_type]} {
4279 # The amend request was rejected...
4281 if {![string match amend
* $commit_type]} {
4282 set selected_commit_type new
4292 global appvers copyright
4293 global tcl_patchLevel tk_patchLevel
4297 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4299 label
$w.header
-text "About [appname]" \
4301 pack
$w.header
-side top
-fill x
4304 button
$w.buttons.close
-text {Close
} \
4306 -command [list destroy
$w]
4307 pack
$w.buttons.close
-side right
4308 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4311 -text "[appname] - a commit creation tool for Git.
4319 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4322 append v
"[appname] version $appvers\n"
4323 append v
"[exec git version]\n"
4325 if {$tcl_patchLevel eq
$tk_patchLevel} {
4326 append v
"Tcl/Tk version $tcl_patchLevel"
4328 append v
"Tcl version $tcl_patchLevel"
4329 append v
", Tk version $tk_patchLevel"
4340 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
4342 menu
$w.ctxm
-tearoff 0
4343 $w.ctxm add
command \
4348 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4351 bind $w <Visibility
> "grab $w; focus $w"
4352 bind $w <Key-Escape
> "destroy $w"
4353 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4354 wm title
$w "About [appname]"
4358 proc do_options
{} {
4359 global repo_config global_config font_descs
4360 global repo_config_new global_config_new
4362 array
unset repo_config_new
4363 array
unset global_config_new
4364 foreach name
[array names repo_config
] {
4365 set repo_config_new
($name) $repo_config($name)
4368 foreach name
[array names repo_config
] {
4370 gui.diffcontext
{continue}
4372 set repo_config_new
($name) $repo_config($name)
4374 foreach name
[array names global_config
] {
4375 set global_config_new
($name) $global_config($name)
4378 set w .options_editor
4380 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4382 label
$w.header
-text "[appname] Options" \
4384 pack
$w.header
-side top
-fill x
4387 button
$w.buttons.restore
-text {Restore Defaults
} \
4389 -command do_restore_defaults
4390 pack
$w.buttons.restore
-side left
4391 button
$w.buttons.save
-text Save \
4393 -command [list do_save_config
$w]
4394 pack
$w.buttons.save
-side right
4395 button
$w.buttons.cancel
-text {Cancel
} \
4397 -command [list destroy
$w]
4398 pack
$w.buttons.cancel
-side right
-padx 5
4399 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4401 labelframe
$w.repo
-text "[reponame] Repository" \
4403 labelframe
$w.global
-text {Global
(All Repositories
)} \
4405 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
4406 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
4410 {t user.name
{User Name
}}
4411 {t user.email
{Email Address
}}
4413 {b merge.summary
{Summarize Merge Commits
}}
4414 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
4416 {b gui.trustmtime
{Trust File Modification Timestamps
}}
4417 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
4418 {t gui.newbranchtemplate
{New Branch Name Template
}}
4420 set type [lindex
$option 0]
4421 set name
[lindex
$option 1]
4422 set text
[lindex
$option 2]
4424 foreach f
{repo global
} {
4425 switch
-glob -- $type {
4427 checkbutton
$w.
$f.
$optid -text $text \
4428 -variable ${f}_config_new
($name) \
4432 pack
$w.
$f.
$optid -side top
-anchor w
4435 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
4437 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4438 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
4439 spinbox
$w.
$f.
$optid.v \
4440 -textvariable ${f}_config_new
($name) \
4444 -width [expr {1 + [string length
$max]}] \
4446 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
4447 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
4448 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4452 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4453 entry
$w.
$f.
$optid.v \
4457 -textvariable ${f}_config_new
($name) \
4459 pack
$w.
$f.
$optid.l
-side left
-anchor w
4460 pack
$w.
$f.
$optid.v
-side left
-anchor w \
4463 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4469 set all_fonts
[lsort
[font families
]]
4470 foreach option
$font_descs {
4471 set name
[lindex
$option 0]
4472 set font
[lindex
$option 1]
4473 set text
[lindex
$option 2]
4475 set global_config_new
(gui.
$font^^family
) \
4476 [font configure
$font -family]
4477 set global_config_new
(gui.
$font^^size
) \
4478 [font configure
$font -size]
4480 frame
$w.global.
$name
4481 label
$w.global.
$name.l
-text "$text:" -font font_ui
4482 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
4483 eval tk_optionMenu
$w.global.
$name.family \
4484 global_config_new
(gui.
$font^^family
) \
4486 spinbox
$w.global.
$name.size \
4487 -textvariable global_config_new
(gui.
$font^^size
) \
4488 -from 2 -to 80 -increment 1 \
4491 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
4492 pack
$w.global.
$name.size
-side right
-anchor e
4493 pack
$w.global.
$name.family
-side right
-anchor e
4494 pack
$w.global.
$name -side top
-anchor w
-fill x
4497 bind $w <Visibility
> "grab $w; focus $w"
4498 bind $w <Key-Escape
> "destroy $w"
4499 wm title
$w "[appname] ([reponame]): Options"
4503 proc do_restore_defaults
{} {
4504 global font_descs default_config repo_config
4505 global repo_config_new global_config_new
4507 foreach name
[array names default_config
] {
4508 set repo_config_new
($name) $default_config($name)
4509 set global_config_new
($name) $default_config($name)
4512 foreach option
$font_descs {
4513 set name
[lindex
$option 0]
4514 set repo_config
(gui.
$name) $default_config(gui.
$name)
4518 foreach option
$font_descs {
4519 set name
[lindex
$option 0]
4520 set font
[lindex
$option 1]
4521 set global_config_new
(gui.
$font^^family
) \
4522 [font configure
$font -family]
4523 set global_config_new
(gui.
$font^^size
) \
4524 [font configure
$font -size]
4528 proc do_save_config
{w
} {
4529 if {[catch
{save_config
} err
]} {
4530 error_popup
"Failed to completely save options:\n\n$err"
4536 proc do_windows_shortcut
{} {
4539 set fn
[tk_getSaveFile \
4541 -title "[appname] ([reponame]): Create Desktop Icon" \
4542 -initialfile "Git [reponame].bat"]
4546 puts
$fd "@ECHO Entering [reponame]"
4547 puts
$fd "@ECHO Starting git-gui... please wait..."
4548 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4549 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
4550 puts
-nonewline $fd "@\"[info nameofexecutable]\""
4551 puts
$fd " \"[file normalize $argv0]\""
4554 error_popup
"Cannot write script:\n\n$err"
4559 proc do_cygwin_shortcut
{} {
4563 set desktop
[exec cygpath \
4571 set fn
[tk_getSaveFile \
4573 -title "[appname] ([reponame]): Create Desktop Icon" \
4574 -initialdir $desktop \
4575 -initialfile "Git [reponame].bat"]
4579 set sh
[exec cygpath \
4583 set me
[exec cygpath \
4587 set gd
[exec cygpath \
4591 set gw
[exec cygpath \
4594 [file dirname [gitdir
]]]
4595 regsub
-all ' $me "'\\''" me
4596 regsub -all ' $gd "'\\''" gd
4597 puts $fd "@ECHO Entering $gw"
4598 puts $fd "@ECHO Starting git-gui... please wait..."
4599 puts -nonewline $fd "@\"$sh\" --login -c \""
4600 puts -nonewline $fd "GIT_DIR='$gd'"
4601 puts -nonewline $fd " '$me'"
4605 error_popup "Cannot write script:\n\n$err"
4610 proc do_macosx_app {} {
4613 set fn [tk_getSaveFile \
4615 -title "[appname] ([reponame]): Create Desktop Icon" \
4616 -initialdir [file join $env(HOME) Desktop] \
4617 -initialfile "Git [reponame].app"]
4620 set Contents [file join $fn Contents]
4621 set MacOS [file join $Contents MacOS]
4622 set exe [file join $MacOS git-gui]
4626 set fd [open [file join $Contents Info.plist] w]
4627 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4628 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4629 <plist version="1.0">
4631 <key>CFBundleDevelopmentRegion</key>
4632 <string>English</string>
4633 <key>CFBundleExecutable</key>
4634 <string>git-gui</string>
4635 <key>CFBundleIdentifier</key>
4636 <string>org.spearce.git-gui</string>
4637 <key>CFBundleInfoDictionaryVersion</key>
4638 <string>6.0</string>
4639 <key>CFBundlePackageType</key>
4640 <string>APPL</string>
4641 <key>CFBundleSignature</key>
4642 <string>????</string>
4643 <key>CFBundleVersion</key>
4644 <string>1.0</string>
4645 <key>NSPrincipalClass</key>
4646 <string>NSApplication</string>
4651 set fd [open $exe w]
4652 set gd [file normalize [gitdir]]
4653 set ep [file normalize [gitexec]]
4654 regsub -all ' $gd "'\\''" gd
4655 regsub
-all ' $ep "'\\''" ep
4656 puts $fd "#!/bin/sh"
4657 foreach name
[array names env
] {
4658 if {[string match GIT_
* $name]} {
4659 regsub
-all ' $env($name) "'\\''" v
4660 puts $fd "export $name='$v'"
4663 puts $fd "export PATH
='$ep':\
$PATH"
4664 puts $fd "export GIT_DIR
='$gd'"
4665 puts $fd "exec [file normalize
$argv0]"
4668 file attributes $exe -permissions u+x,g+x,o+x
4670 error_popup "Cannot
write icon
:\n\n$err"
4675 proc toggle_or_diff {w x y} {
4676 global file_states file_lists current_diff_path ui_index ui_workdir
4677 global last_clicked selected_paths
4679 set pos [split [$w index @$x,$y] .]
4680 set lno [lindex $pos 0]
4681 set col [lindex $pos 1]
4682 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4688 set last_clicked [list $w $lno]
4689 array unset selected_paths
4690 $ui_index tag remove in_sel 0.0 end
4691 $ui_workdir tag remove in_sel 0.0 end
4694 if {$current_diff_path eq $path} {
4695 set after {reshow_diff;}
4699 if {$w eq $ui_index} {
4701 "Unstaging
[short_path
$path] from commit
" \
4703 [concat $after {set ui_status_value {Ready.}}]
4704 } elseif {$w eq $ui_workdir} {
4706 "Adding
[short_path
$path]" \
4708 [concat $after {set ui_status_value {Ready.}}]
4711 show_diff $path $w $lno
4715 proc add_one_to_selection {w x y} {
4716 global file_lists last_clicked selected_paths
4718 set lno [lindex [split [$w index @$x,$y] .] 0]
4719 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4725 if {$last_clicked ne {}
4726 && [lindex $last_clicked 0] ne $w} {
4727 array unset selected_paths
4728 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4731 set last_clicked [list $w $lno]
4732 if {[catch {set in_sel $selected_paths($path)}]} {
4736 unset selected_paths($path)
4737 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4739 set selected_paths($path) 1
4740 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4744 proc add_range_to_selection {w x y} {
4745 global file_lists last_clicked selected_paths
4747 if {[lindex $last_clicked 0] ne $w} {
4748 toggle_or_diff $w $x $y
4752 set lno [lindex [split [$w index @$x,$y] .] 0]
4753 set lc [lindex $last_clicked 1]
4762 foreach path [lrange $file_lists($w) \
4763 [expr {$begin - 1}] \
4764 [expr {$end - 1}]] {
4765 set selected_paths($path) 1
4767 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4770 ######################################################################
4774 set cursor_ptr arrow
4775 font create font_diff -family Courier -size 10
4779 eval font configure font_ui [font actual [.dummy cget -font]]
4783 font create font_uibold
4784 font create font_diffbold
4789 } elseif {[is_MacOSX]} {
4797 proc apply_config {} {
4798 global repo_config font_descs
4800 foreach option $font_descs {
4801 set name [lindex $option 0]
4802 set font [lindex $option 1]
4804 foreach {cn cv} $repo_config(gui.$name) {
4805 font configure $font $cn $cv
4808 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
4810 foreach {cn cv} [font configure $font] {
4811 font configure ${font}bold $cn $cv
4813 font configure ${font}bold -weight bold
4817 set default_config(merge.summary) false
4818 set default_config(merge.verbosity) 2
4819 set default_config(user.name) {}
4820 set default_config(user.email) {}
4822 set default_config(gui.trustmtime) false
4823 set default_config(gui.diffcontext) 5
4824 set default_config(gui.newbranchtemplate) {}
4825 set default_config(gui.fontui) [font configure font_ui]
4826 set default_config(gui.fontdiff) [font configure font_diff]
4828 {fontui font_ui {Main Font}}
4829 {fontdiff font_diff {Diff/Console Font}}
4834 ######################################################################
4840 menu .mbar -tearoff 0
4841 .mbar add cascade -label Repository -menu .mbar.repository
4842 .mbar add cascade -label Edit -menu .mbar.edit
4843 if {!$single_commit} {
4844 .mbar add cascade -label Branch -menu .mbar.branch
4846 .mbar add cascade -label Commit -menu .mbar.commit
4847 if {!$single_commit} {
4848 .mbar add cascade -label Merge -menu .mbar.merge
4849 .mbar add cascade -label Fetch -menu .mbar.fetch
4850 .mbar add cascade -label Push -menu .mbar.push
4852 . configure -menu .mbar
4854 # -- Repository Menu
4856 menu .mbar.repository
4858 .mbar.repository add command \
4859 -label {Browse Current Branch} \
4860 -command {new_browser $current_branch} \
4862 .mbar.repository add separator
4864 .mbar.repository add command \
4865 -label {Visualize Current Branch} \
4866 -command {do_gitk {}} \
4868 .mbar.repository add command \
4869 -label {Visualize All Branches} \
4870 -command {do_gitk {--all}} \
4872 .mbar.repository add separator
4874 if {!$single_commit} {
4875 .mbar.repository add command -label {Database Statistics} \
4879 .mbar.repository add command -label {Compress Database} \
4883 .mbar.repository add command -label {Verify Database} \
4884 -command do_fsck_objects \
4887 .mbar.repository add separator
4890 .mbar.repository add command \
4891 -label {Create Desktop Icon} \
4892 -command do_cygwin_shortcut \
4894 } elseif {[is_Windows]} {
4895 .mbar.repository add command \
4896 -label {Create Desktop Icon} \
4897 -command do_windows_shortcut \
4899 } elseif {[is_MacOSX]} {
4900 .mbar.repository add command \
4901 -label {Create Desktop Icon} \
4902 -command do_macosx_app \
4907 .mbar.repository add command -label Quit \
4909 -accelerator $M1T-Q \
4915 .mbar.edit add command -label Undo \
4916 -command {catch {[focus] edit undo}} \
4917 -accelerator $M1T-Z \
4919 .mbar.edit add command -label Redo \
4920 -command {catch {[focus] edit redo}} \
4921 -accelerator $M1T-Y \
4923 .mbar.edit add separator
4924 .mbar.edit add command -label Cut \
4925 -command {catch {tk_textCut [focus]}} \
4926 -accelerator $M1T-X \
4928 .mbar.edit add command -label Copy \
4929 -command {catch {tk_textCopy [focus]}} \
4930 -accelerator $M1T-C \
4932 .mbar.edit add command -label Paste \
4933 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4934 -accelerator $M1T-V \
4936 .mbar.edit add command -label Delete \
4937 -command {catch {[focus] delete sel.first sel.last}} \
4940 .mbar.edit add separator
4941 .mbar.edit add command -label {Select All} \
4942 -command {catch {[focus] tag add sel 0.0 end}} \
4943 -accelerator $M1T-A \
4948 if {!$single_commit} {
4951 .mbar.branch add command -label {Create...} \
4952 -command do_create_branch \
4953 -accelerator $M1T-N \
4955 lappend disable_on_lock [list .mbar.branch entryconf \
4956 [.mbar.branch index last] -state]
4958 .mbar.branch add command -label {Delete...} \
4959 -command do_delete_branch \
4961 lappend disable_on_lock [list .mbar.branch entryconf \
4962 [.mbar.branch index last] -state]
4969 .mbar.commit add radiobutton \
4970 -label {New Commit} \
4971 -command do_select_commit_type \
4972 -variable selected_commit_type \
4975 lappend disable_on_lock \
4976 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4978 .mbar.commit add radiobutton \
4979 -label {Amend Last Commit} \
4980 -command do_select_commit_type \
4981 -variable selected_commit_type \
4984 lappend disable_on_lock \
4985 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4987 .mbar.commit add separator
4989 .mbar.commit add command -label Rescan \
4990 -command do_rescan \
4993 lappend disable_on_lock \
4994 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4996 .mbar.commit add command -label {Add To Commit} \
4997 -command do_add_selection \
4999 lappend disable_on_lock \
5000 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5002 .mbar.commit add command -label {Add All To Commit} \
5003 -command do_add_all \
5004 -accelerator $M1T-I \
5006 lappend disable_on_lock \
5007 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5009 .mbar.commit add command -label {Unstage From Commit} \
5010 -command do_unstage_selection \
5012 lappend disable_on_lock \
5013 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5015 .mbar.commit add command -label {Revert Changes} \
5016 -command do_revert_selection \
5018 lappend disable_on_lock \
5019 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5021 .mbar.commit add separator
5023 .mbar.commit add command -label {Sign Off} \
5024 -command do_signoff \
5025 -accelerator $M1T-S \
5028 .mbar.commit add command -label Commit \
5029 -command do_commit \
5030 -accelerator $M1T-Return \
5032 lappend disable_on_lock \
5033 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5036 # -- Apple Menu (Mac OS X only)
5038 .mbar add cascade -label Apple -menu .mbar.apple
5041 .mbar.apple add command -label "About
[appname
]" \
5044 .mbar.apple add command -label "[appname
] Options...
" \
5045 -command do_options \
5050 .mbar.edit add separator
5051 .mbar.edit add command -label {Options...} \
5052 -command do_options \
5057 if {[file exists /usr/local/miga/lib/gui-miga]
5058 && [file exists .pvcsrc]} {
5060 global ui_status_value
5061 if {![lock_index update]} return
5062 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
5063 set miga_fd [open "|
$cmd" r]
5064 fconfigure $miga_fd -blocking 0
5065 fileevent $miga_fd readable [list miga_done $miga_fd]
5066 set ui_status_value {Running miga...}
5068 proc miga_done {fd} {
5073 rescan [list set ui_status_value {Ready.}]
5076 .mbar add cascade -label Tools -menu .mbar.tools
5078 .mbar.tools add command -label "Migrate
" \
5081 lappend disable_on_lock \
5082 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5088 .mbar add cascade -label Help -menu .mbar.help
5092 .mbar.help add command -label "About
[appname
]" \
5098 catch {set browser $repo_config(instaweb.browser)}
5099 set doc_path [file dirname [gitexec]]
5100 set doc_path [file join $doc_path Documentation index.html]
5103 set doc_path [exec cygpath --windows $doc_path]
5106 if {$browser eq {}} {
5109 } elseif {[is_Cygwin]} {
5110 set program_files [file dirname [exec cygpath --windir]]
5111 set program_files [file join $program_files {Program Files}]
5112 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5113 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5114 if {[file exists $firefox]} {
5115 set browser $firefox
5116 } elseif {[file exists $ie]} {
5119 unset program_files firefox ie
5123 if {[file isfile $doc_path]} {
5124 set doc_url "file:$doc_path"
5126 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5129 if {$browser ne {}} {
5130 .mbar.help add command -label {Online Documentation} \
5131 -command [list exec $browser $doc_url &] \
5134 unset browser doc_path doc_url
5142 -text {Current Branch:} \
5147 -textvariable current_branch \
5151 pack .branch.l1 -side left
5152 pack .branch.cb -side left -fill x
5153 pack .branch -side top -fill x
5155 if {!$single_commit} {
5157 .mbar.merge add command -label {Local Merge...} \
5158 -command do_local_merge \
5160 lappend disable_on_lock \
5161 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5162 .mbar.merge add command -label {Abort Merge...} \
5163 -command do_reset_hard \
5165 lappend disable_on_lock \
5166 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5172 .mbar.push add command -label {Push...} \
5173 -command do_push_anywhere \
5177 # -- Main Window Layout
5179 panedwindow .vpane -orient vertical
5180 panedwindow .vpane.files -orient horizontal
5181 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5182 pack .vpane -anchor n -side top -fill both -expand 1
5184 # -- Index File List
5186 frame .vpane.files.index -height 100 -width 200
5187 label .vpane.files.index.title -text {Changes To Be Committed} \
5190 text $ui_index -background white -borderwidth 0 \
5191 -width 20 -height 10 \
5194 -cursor $cursor_ptr \
5195 -xscrollcommand {.vpane.files.index.sx set} \
5196 -yscrollcommand {.vpane.files.index.sy set} \
5198 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5199 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5200 pack .vpane.files.index.title -side top -fill x
5201 pack .vpane.files.index.sx -side bottom -fill x
5202 pack .vpane.files.index.sy -side right -fill y
5203 pack $ui_index -side left -fill both -expand 1
5204 .vpane.files add .vpane.files.index -sticky nsew
5206 # -- Working Directory File List
5208 frame .vpane.files.workdir -height 100 -width 200
5209 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5212 text $ui_workdir -background white -borderwidth 0 \
5213 -width 20 -height 10 \
5216 -cursor $cursor_ptr \
5217 -xscrollcommand {.vpane.files.workdir.sx set} \
5218 -yscrollcommand {.vpane.files.workdir.sy set} \
5220 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5221 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5222 pack .vpane.files.workdir.title -side top -fill x
5223 pack .vpane.files.workdir.sx -side bottom -fill x
5224 pack .vpane.files.workdir.sy -side right -fill y
5225 pack $ui_workdir -side left -fill both -expand 1
5226 .vpane.files add .vpane.files.workdir -sticky nsew
5228 foreach i [list $ui_index $ui_workdir] {
5229 $i tag conf in_diff -font font_uibold
5230 $i tag conf in_sel \
5231 -background [$i cget -foreground] \
5232 -foreground [$i cget -background]
5236 # -- Diff and Commit Area
5238 frame .vpane.lower -height 300 -width 400
5239 frame .vpane.lower.commarea
5240 frame .vpane.lower.diff -relief sunken -borderwidth 1
5241 pack .vpane.lower.commarea -side top -fill x
5242 pack .vpane.lower.diff -side bottom -fill both -expand 1
5243 .vpane add .vpane.lower -sticky nsew
5245 # -- Commit Area Buttons
5247 frame .vpane.lower.commarea.buttons
5248 label .vpane.lower.commarea.buttons.l -text {} \
5252 pack .vpane.lower.commarea.buttons.l -side top -fill x
5253 pack .vpane.lower.commarea.buttons -side left -fill y
5255 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5256 -command do_rescan \
5258 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5259 lappend disable_on_lock \
5260 {.vpane.lower.commarea.buttons.rescan conf -state}
5262 button .vpane.lower.commarea.buttons.incall -text {Add All} \
5263 -command do_add_all \
5265 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5266 lappend disable_on_lock \
5267 {.vpane.lower.commarea.buttons.incall conf -state}
5269 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5270 -command do_signoff \
5272 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5274 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5275 -command do_commit \
5277 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5278 lappend disable_on_lock \
5279 {.vpane.lower.commarea.buttons.commit conf -state}
5281 # -- Commit Message Buffer
5283 frame .vpane.lower.commarea.buffer
5284 frame .vpane.lower.commarea.buffer.header
5285 set ui_comm .vpane.lower.commarea.buffer.t
5286 set ui_coml .vpane.lower.commarea.buffer.header.l
5287 radiobutton .vpane.lower.commarea.buffer.header.new \
5288 -text {New Commit} \
5289 -command do_select_commit_type \
5290 -variable selected_commit_type \
5293 lappend disable_on_lock \
5294 [list .vpane.lower.commarea.buffer.header.new conf -state]
5295 radiobutton .vpane.lower.commarea.buffer.header.amend \
5296 -text {Amend Last Commit} \
5297 -command do_select_commit_type \
5298 -variable selected_commit_type \
5301 lappend disable_on_lock \
5302 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5307 proc trace_commit_type {varname args} {
5308 global ui_coml commit_type
5309 switch -glob -- $commit_type {
5310 initial {set txt {Initial Commit Message:}}
5311 amend {set txt {Amended Commit Message:}}
5312 amend-initial {set txt {Amended Initial Commit Message:}}
5313 amend-merge {set txt {Amended Merge Commit Message:}}
5314 merge {set txt {Merge Commit Message:}}
5315 * {set txt {Commit Message:}}
5317 $ui_coml conf -text $txt
5319 trace add variable commit_type write trace_commit_type
5320 pack $ui_coml -side left -fill x
5321 pack .vpane.lower.commarea.buffer.header.amend -side right
5322 pack .vpane.lower.commarea.buffer.header.new -side right
5324 text $ui_comm -background white -borderwidth 1 \
5327 -autoseparators true \
5329 -width 75 -height 9 -wrap none \
5331 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5332 scrollbar .vpane.lower.commarea.buffer.sby \
5333 -command [list $ui_comm yview]
5334 pack .vpane.lower.commarea.buffer.header -side top -fill x
5335 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5336 pack $ui_comm -side left -fill y
5337 pack .vpane.lower.commarea.buffer -side left -fill y
5339 # -- Commit Message Buffer Context Menu
5341 set ctxm .vpane.lower.commarea.buffer.ctxm
5342 menu $ctxm -tearoff 0
5346 -command {tk_textCut $ui_comm}
5350 -command {tk_textCopy $ui_comm}
5354 -command {tk_textPaste $ui_comm}
5358 -command {$ui_comm delete sel.first sel.last}
5361 -label {Select All} \
5363 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5368 $ui_comm tag add sel 0.0 end
5369 tk_textCopy $ui_comm
5370 $ui_comm tag remove sel 0.0 end
5377 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
5381 set current_diff_path {}
5382 set current_diff_side {}
5383 set diff_actions [list]
5384 proc trace_current_diff_path {varname args} {
5385 global current_diff_path diff_actions file_states
5386 if {$current_diff_path eq {}} {
5392 set p $current_diff_path
5393 set s [mapdesc [lindex $file_states($p) 0] $p]
5395 set p [escape_path $p]
5399 .vpane.lower.diff.header.status configure -text $s
5400 .vpane.lower.diff.header.file configure -text $f
5401 .vpane.lower.diff.header.path configure -text $p
5402 foreach w $diff_actions {
5406 trace add variable current_diff_path write trace_current_diff_path
5408 frame .vpane.lower.diff.header -background orange
5409 label .vpane.lower.diff.header.status \
5410 -background orange \
5411 -width $max_status_desc \
5415 label .vpane.lower.diff.header.file \
5416 -background orange \
5420 label .vpane.lower.diff.header.path \
5421 -background orange \
5425 pack .vpane.lower.diff.header.status -side left
5426 pack .vpane.lower.diff.header.file -side left
5427 pack .vpane.lower.diff.header.path -fill x
5428 set ctxm .vpane.lower.diff.header.ctxm
5429 menu $ctxm -tearoff 0
5438 -- $current_diff_path
5440 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5441 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
5445 frame .vpane.lower.diff.body
5446 set ui_diff .vpane.lower.diff.body.t
5447 text $ui_diff -background white -borderwidth 0 \
5448 -width 80 -height 15 -wrap none \
5450 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5451 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5453 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5454 -command [list $ui_diff xview]
5455 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5456 -command [list $ui_diff yview]
5457 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5458 pack .vpane.lower.diff.body.sby -side right -fill y
5459 pack $ui_diff -side left -fill both -expand 1
5460 pack .vpane.lower.diff.header -side top -fill x
5461 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5463 $ui_diff tag conf d_cr -elide true
5464 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5465 $ui_diff tag conf d_+ -foreground {#00a000}
5466 $ui_diff tag conf d_- -foreground red
5468 $ui_diff tag conf d_++ -foreground {#00a000}
5469 $ui_diff tag conf d_-- -foreground red
5470 $ui_diff tag conf d_+s \
5471 -foreground {#00a000} \
5472 -background {#e2effa}
5473 $ui_diff tag conf d_-s \
5475 -background {#e2effa}
5476 $ui_diff tag conf d_s+ \
5477 -foreground {#00a000} \
5479 $ui_diff tag conf d_s- \
5483 $ui_diff tag conf d<<<<<<< \
5484 -foreground orange \
5486 $ui_diff tag conf d======= \
5487 -foreground orange \
5489 $ui_diff tag conf d>>>>>>> \
5490 -foreground orange \
5493 $ui_diff tag raise sel
5495 # -- Diff Body Context Menu
5497 set ctxm .vpane.lower.diff.body.ctxm
5498 menu $ctxm -tearoff 0
5502 -command reshow_diff
5503 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5507 -command {tk_textCopy $ui_diff}
5508 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5510 -label {Select All} \
5512 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5513 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5518 $ui_diff tag add sel 0.0 end
5519 tk_textCopy $ui_diff
5520 $ui_diff tag remove sel 0.0 end
5522 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5525 -label {Apply/Reverse Hunk} \
5527 -command {apply_hunk $cursorX $cursorY}
5528 set ui_diff_applyhunk [$ctxm index last]
5529 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5532 -label {Decrease Font Size} \
5534 -command {incr_font_size font_diff -1}
5535 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5537 -label {Increase Font Size} \
5539 -command {incr_font_size font_diff 1}
5540 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5543 -label {Show Less Context} \
5545 -command {if {$repo_config(gui.diffcontext) >= 2} {
5546 incr repo_config(gui.diffcontext) -1
5549 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5551 -label {Show More Context} \
5554 incr repo_config(gui.diffcontext)
5557 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5559 $ctxm add command -label {Options...} \
5562 bind_button3 $ui_diff "
5565 if {\
$ui_index eq \
$current_diff_side} {
5566 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
5568 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
5570 tk_popup
$ctxm %X
%Y
5572 unset ui_diff_applyhunk
5576 set ui_status_value {Initializing...}
5577 label .status -textvariable ui_status_value \
5583 pack .status -anchor w -side bottom -fill x
5588 set gm $repo_config(gui.geometry)
5589 wm geometry . [lindex $gm 0]
5590 .vpane sash place 0 \
5591 [lindex [.vpane sash coord 0] 0] \
5593 .vpane.files sash place 0 \
5595 [lindex [.vpane.files sash coord 0] 1]
5601 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5602 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5603 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5604 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5605 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5606 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5607 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5608 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5609 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5610 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5611 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5613 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5614 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5615 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5616 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5617 bind $ui_diff <$M1B-Key-v> {break}
5618 bind $ui_diff <$M1B-Key-V> {break}
5619 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5620 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5621 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5622 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5623 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5624 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5625 bind $ui_diff <Button-1> {focus %W}
5627 if {!$single_commit} {
5628 bind . <$M1B-Key-n> do_create_branch
5629 bind . <$M1B-Key-N> do_create_branch
5632 bind . <Destroy> do_quit
5633 bind all <Key-F5> do_rescan
5634 bind all <$M1B-Key-r> do_rescan
5635 bind all <$M1B-Key-R> do_rescan
5636 bind . <$M1B-Key-s> do_signoff
5637 bind . <$M1B-Key-S> do_signoff
5638 bind . <$M1B-Key-i> do_add_all
5639 bind . <$M1B-Key-I> do_add_all
5640 bind . <$M1B-Key-Return> do_commit
5641 bind all <$M1B-Key-q> do_quit
5642 bind all <$M1B-Key-Q> do_quit
5643 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5644 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5645 foreach i [list $ui_index $ui_workdir] {
5646 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
5647 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
5648 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
5652 set file_lists($ui_index) [list]
5653 set file_lists($ui_workdir) [list]
5657 set MERGE_HEAD [list]
5660 set current_branch {}
5661 set current_diff_path {}
5662 set selected_commit_type new
5664 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
5665 focus -force $ui_comm
5667 # -- Warn the user about environmental problems. Cygwin's Tcl
5668 # does *not* pass its env array onto any processes it spawns.
5669 # This means that git processes get none of our environment.
5674 set msg "Possible environment issues exist.
5676 The following environment variables are probably
5677 going to be ignored by any Git subprocess run
5681 foreach name [array names env] {
5682 switch -regexp -- $name {
5683 {^GIT_INDEX_FILE$} -
5684 {^GIT_OBJECT_DIRECTORY$} -
5685 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5687 {^GIT_EXTERNAL_DIFF$} -
5691 {^GIT_CONFIG_LOCAL$} -
5692 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5693 append msg " - $name\n"
5696 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5697 append msg " - $name\n"
5699 set suggest_user $name
5703 if {$ignored_env > 0} {
5705 This is due to a known issue with the
5706 Tcl binary distributed by Cygwin.
"
5708 if {$suggest_user ne {}} {
5711 A good replacement
for $suggest_user
5712 is placing values
for the user.name and
5713 user.email settings into your personal
5719 unset ignored_env msg suggest_user name
5722 # -- Only initialize complex UI if we are going to stay running.
5724 if {!$single_commit} {
5728 populate_branch_menu
5733 # -- Only suggest a gc run if we are going to stay running.
5735 if {!$single_commit} {
5736 set object_limit 2000
5737 if {[is_Windows]} {set object_limit 200}
5738 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5739 if {$objects_current >= $object_limit} {
5741 "This repository currently has
$objects_current loose objects.
5743 To maintain optimal performance it is strongly
5744 recommended that you
compress the database
5745 when
more than
$object_limit loose objects exist.
5747 Compress the database now?
"] eq yes} {
5751 unset object_limit _junk objects_current
5754 lock_index begin-read