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 {\\} $path "\\\\" path
1385 regsub
-all "\n" $path "\\n" path
1389 proc short_path
{path
} {
1390 return [escape_path
[lindex
[file split $path] end
]]
1394 set null_sha1
[string repeat
0 40]
1396 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1397 global file_states next_icon_id null_sha1
1399 set s0
[string index
$new_state 0]
1400 set s1
[string index
$new_state 1]
1402 if {[catch
{set info
$file_states($path)}]} {
1404 set icon n
[incr next_icon_id
]
1406 set state
[lindex
$info 0]
1407 set icon
[lindex
$info 1]
1408 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1409 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1412 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1413 elseif
{$s0 eq
{_
}} {set s0 _
}
1415 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1416 elseif
{$s1 eq
{_
}} {set s1 _
}
1418 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1419 set head_info
[list
0 $null_sha1]
1420 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1421 && $head_info eq
{}} {
1422 set head_info
$index_info
1425 set file_states
($path) [list
$s0$s1 $icon \
1426 $head_info $index_info \
1431 proc display_file_helper
{w path icon_name old_m new_m
} {
1434 if {$new_m eq
{_
}} {
1435 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1437 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1439 $w conf
-state normal
1440 $w delete
$lno.0 [expr {$lno + 1}].0
1441 $w conf
-state disabled
1443 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1444 lappend file_lists
($w) $path
1445 set file_lists
($w) [lsort
-unique $file_lists($w)]
1446 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1448 $w conf
-state normal
1449 $w image create
$lno.0 \
1450 -align center
-padx 5 -pady 1 \
1452 -image [mapicon
$w $new_m $path]
1453 $w insert
$lno.1 "[escape_path $path]\n"
1454 $w conf
-state disabled
1455 } elseif
{$old_m ne
$new_m} {
1456 $w conf
-state normal
1457 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1458 $w conf
-state disabled
1462 proc display_file
{path state
} {
1463 global file_states selected_paths
1464 global ui_index ui_workdir
1466 set old_m
[merge_state
$path $state]
1467 set s
$file_states($path)
1468 set new_m
[lindex
$s 0]
1469 set icon_name
[lindex
$s 1]
1471 set o
[string index
$old_m 0]
1472 set n
[string index
$new_m 0]
1479 display_file_helper
$ui_index $path $icon_name $o $n
1481 if {[string index
$old_m 0] eq
{U
}} {
1484 set o
[string index
$old_m 1]
1486 if {[string index
$new_m 0] eq
{U
}} {
1489 set n
[string index
$new_m 1]
1491 display_file_helper
$ui_workdir $path $icon_name $o $n
1493 if {$new_m eq
{__
}} {
1494 unset file_states
($path)
1495 catch
{unset selected_paths
($path)}
1499 proc display_all_files_helper
{w path icon_name m
} {
1502 lappend file_lists
($w) $path
1503 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1504 $w image create end \
1505 -align center
-padx 5 -pady 1 \
1507 -image [mapicon
$w $m $path]
1508 $w insert end
"[escape_path $path]\n"
1511 proc display_all_files
{} {
1512 global ui_index ui_workdir
1513 global file_states file_lists
1516 $ui_index conf
-state normal
1517 $ui_workdir conf
-state normal
1519 $ui_index delete
0.0 end
1520 $ui_workdir delete
0.0 end
1523 set file_lists
($ui_index) [list
]
1524 set file_lists
($ui_workdir) [list
]
1526 foreach path
[lsort
[array names file_states
]] {
1527 set s
$file_states($path)
1529 set icon_name
[lindex
$s 1]
1531 set s
[string index
$m 0]
1532 if {$s ne
{U
} && $s ne
{_
}} {
1533 display_all_files_helper
$ui_index $path \
1537 if {[string index
$m 0] eq
{U
}} {
1540 set s
[string index
$m 1]
1543 display_all_files_helper
$ui_workdir $path \
1548 $ui_index conf
-state disabled
1549 $ui_workdir conf
-state disabled
1552 proc update_indexinfo
{msg pathList after
} {
1553 global update_index_cp ui_status_value
1555 if {![lock_index update
]} return
1557 set update_index_cp
0
1558 set pathList
[lsort
$pathList]
1559 set totalCnt
[llength
$pathList]
1560 set batch [expr {int
($totalCnt * .01) + 1}]
1561 if {$batch > 25} {set batch 25}
1563 set ui_status_value
[format \
1564 "$msg... %i/%i files (%.2f%%)" \
1568 set fd
[open
"| git update-index -z --index-info" w
]
1575 fileevent
$fd writable
[list \
1576 write_update_indexinfo \
1586 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1587 global update_index_cp ui_status_value
1588 global file_states current_diff_path
1590 if {$update_index_cp >= $totalCnt} {
1597 for {set i
$batch} \
1598 {$update_index_cp < $totalCnt && $i > 0} \
1600 set path
[lindex
$pathList $update_index_cp]
1601 incr update_index_cp
1603 set s
$file_states($path)
1604 switch
-glob -- [lindex
$s 0] {
1611 set info
[lindex
$s 2]
1612 if {$info eq
{}} continue
1614 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1615 display_file
$path $new
1618 set ui_status_value
[format \
1619 "$msg... %i/%i files (%.2f%%)" \
1622 [expr {100.0 * $update_index_cp / $totalCnt}]]
1625 proc update_index
{msg pathList after
} {
1626 global update_index_cp ui_status_value
1628 if {![lock_index update
]} return
1630 set update_index_cp
0
1631 set pathList
[lsort
$pathList]
1632 set totalCnt
[llength
$pathList]
1633 set batch [expr {int
($totalCnt * .01) + 1}]
1634 if {$batch > 25} {set batch 25}
1636 set ui_status_value
[format \
1637 "$msg... %i/%i files (%.2f%%)" \
1641 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1648 fileevent
$fd writable
[list \
1649 write_update_index \
1659 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1660 global update_index_cp ui_status_value
1661 global file_states current_diff_path
1663 if {$update_index_cp >= $totalCnt} {
1670 for {set i
$batch} \
1671 {$update_index_cp < $totalCnt && $i > 0} \
1673 set path
[lindex
$pathList $update_index_cp]
1674 incr update_index_cp
1676 switch
-glob -- [lindex
$file_states($path) 0] {
1682 if {[file exists
$path]} {
1691 puts
-nonewline $fd "[encoding convertto $path]\0"
1692 display_file
$path $new
1695 set ui_status_value
[format \
1696 "$msg... %i/%i files (%.2f%%)" \
1699 [expr {100.0 * $update_index_cp / $totalCnt}]]
1702 proc checkout_index
{msg pathList after
} {
1703 global update_index_cp ui_status_value
1705 if {![lock_index update
]} return
1707 set update_index_cp
0
1708 set pathList
[lsort
$pathList]
1709 set totalCnt
[llength
$pathList]
1710 set batch [expr {int
($totalCnt * .01) + 1}]
1711 if {$batch > 25} {set batch 25}
1713 set ui_status_value
[format \
1714 "$msg... %i/%i files (%.2f%%)" \
1718 set cmd
[list git checkout-index
]
1724 set fd
[open
"| $cmd " w
]
1731 fileevent
$fd writable
[list \
1732 write_checkout_index \
1742 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1743 global update_index_cp ui_status_value
1744 global file_states current_diff_path
1746 if {$update_index_cp >= $totalCnt} {
1753 for {set i
$batch} \
1754 {$update_index_cp < $totalCnt && $i > 0} \
1756 set path
[lindex
$pathList $update_index_cp]
1757 incr update_index_cp
1758 switch
-glob -- [lindex
$file_states($path) 0] {
1762 puts
-nonewline $fd "[encoding convertto $path]\0"
1763 display_file
$path ?_
1768 set ui_status_value
[format \
1769 "$msg... %i/%i files (%.2f%%)" \
1772 [expr {100.0 * $update_index_cp / $totalCnt}]]
1775 ######################################################################
1777 ## branch management
1779 proc is_tracking_branch
{name
} {
1780 global tracking_branches
1782 if {![catch
{set info
$tracking_branches($name)}]} {
1785 foreach t
[array names tracking_branches
] {
1786 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1793 proc load_all_heads
{} {
1796 set all_heads
[list
]
1797 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1798 while {[gets
$fd line
] > 0} {
1799 if {[is_tracking_branch
$line]} continue
1800 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1801 lappend all_heads
$name
1805 set all_heads
[lsort
$all_heads]
1808 proc populate_branch_menu
{} {
1809 global all_heads disable_on_lock
1812 set last
[$m index last
]
1813 for {set i
0} {$i <= $last} {incr i
} {
1814 if {[$m type $i] eq
{separator
}} {
1817 foreach a
$disable_on_lock {
1818 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1822 set disable_on_lock
$new_dol
1827 if {$all_heads ne
{}} {
1830 foreach b
$all_heads {
1831 $m add radiobutton \
1833 -command [list switch_branch
$b] \
1834 -variable current_branch \
1837 lappend disable_on_lock \
1838 [list
$m entryconf
[$m index last
] -state]
1842 proc all_tracking_branches
{} {
1843 global tracking_branches
1845 set all_trackings
{}
1847 foreach name
[array names tracking_branches
] {
1848 if {[regsub
{/\
*$
} $name {} name
]} {
1851 regsub ^refs
/(heads|remotes
)/ $name {} name
1852 lappend all_trackings
$name
1857 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1858 while {[gets
$fd name
] > 0} {
1859 regsub ^refs
/(heads|remotes
)/ $name {} name
1860 lappend all_trackings
$name
1865 return [lsort
-unique $all_trackings]
1868 proc do_create_branch_action
{w
} {
1869 global all_heads null_sha1 repo_config
1870 global create_branch_checkout create_branch_revtype
1871 global create_branch_head create_branch_trackinghead
1872 global create_branch_name create_branch_revexp
1874 set newbranch
$create_branch_name
1875 if {$newbranch eq
{}
1876 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1880 -title [wm title
$w] \
1882 -message "Please supply a branch name."
1883 focus
$w.desc.name_t
1886 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1890 -title [wm title
$w] \
1892 -message "Branch '$newbranch' already exists."
1893 focus
$w.desc.name_t
1896 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1900 -title [wm title
$w] \
1902 -message "We do not like '$newbranch' as a branch name."
1903 focus
$w.desc.name_t
1908 switch
-- $create_branch_revtype {
1909 head {set rev $create_branch_head}
1910 tracking
{set rev $create_branch_trackinghead}
1911 expression
{set rev $create_branch_revexp}
1913 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1917 -title [wm title
$w] \
1919 -message "Invalid starting revision: $rev"
1922 set cmd
[list git update-ref
]
1924 lappend cmd
"branch: Created from $rev"
1925 lappend cmd
"refs/heads/$newbranch"
1927 lappend cmd
$null_sha1
1928 if {[catch
{eval exec $cmd} err
]} {
1932 -title [wm title
$w] \
1934 -message "Failed to create '$newbranch'.\n\n$err"
1938 lappend all_heads
$newbranch
1939 set all_heads
[lsort
$all_heads]
1940 populate_branch_menu
1942 if {$create_branch_checkout} {
1943 switch_branch
$newbranch
1947 proc radio_selector
{varname value args
} {
1948 upvar
#0 $varname var
1952 trace add variable create_branch_head
write \
1953 [list radio_selector create_branch_revtype
head]
1954 trace add variable create_branch_trackinghead
write \
1955 [list radio_selector create_branch_revtype tracking
]
1957 trace add variable delete_branch_head
write \
1958 [list radio_selector delete_branch_checktype
head]
1959 trace add variable delete_branch_trackinghead
write \
1960 [list radio_selector delete_branch_checktype tracking
]
1962 proc do_create_branch
{} {
1963 global all_heads current_branch repo_config
1964 global create_branch_checkout create_branch_revtype
1965 global create_branch_head create_branch_trackinghead
1966 global create_branch_name create_branch_revexp
1968 set w .branch_editor
1970 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1972 label
$w.header
-text {Create New Branch
} \
1974 pack
$w.header
-side top
-fill x
1977 button
$w.buttons.create
-text Create \
1980 -command [list do_create_branch_action
$w]
1981 pack
$w.buttons.create
-side right
1982 button
$w.buttons.cancel
-text {Cancel
} \
1984 -command [list destroy
$w]
1985 pack
$w.buttons.cancel
-side right
-padx 5
1986 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1988 labelframe
$w.desc \
1989 -text {Branch Description
} \
1991 label
$w.desc.name_l
-text {Name
:} -font font_ui
1992 entry
$w.desc.name_t \
1996 -textvariable create_branch_name \
2000 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
2003 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
2004 grid columnconfigure
$w.desc
1 -weight 1
2005 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2007 labelframe
$w.from \
2008 -text {Starting Revision
} \
2010 radiobutton
$w.from.head_r \
2011 -text {Local Branch
:} \
2013 -variable create_branch_revtype \
2015 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2016 grid
$w.from.head_r
$w.from.head_m
-sticky w
2017 set all_trackings
[all_tracking_branches
]
2018 if {$all_trackings ne
{}} {
2019 set create_branch_trackinghead
[lindex
$all_trackings 0]
2020 radiobutton
$w.from.tracking_r \
2021 -text {Tracking Branch
:} \
2023 -variable create_branch_revtype \
2025 eval tk_optionMenu
$w.from.tracking_m \
2026 create_branch_trackinghead \
2028 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2030 radiobutton
$w.from.exp_r \
2031 -text {Revision Expression
:} \
2033 -variable create_branch_revtype \
2035 entry
$w.from.exp_t \
2039 -textvariable create_branch_revexp \
2043 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2044 if {%d
== 1 && [string length
%S
] > 0} {
2045 set create_branch_revtype expression
2049 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2050 grid columnconfigure
$w.from
1 -weight 1
2051 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2053 labelframe
$w.postActions \
2054 -text {Post Creation Actions
} \
2056 checkbutton
$w.postActions.checkout \
2057 -text {Checkout after creation
} \
2058 -variable create_branch_checkout \
2060 pack
$w.postActions.checkout
-anchor nw
2061 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2063 set create_branch_checkout
1
2064 set create_branch_head
$current_branch
2065 set create_branch_revtype
head
2066 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2067 set create_branch_revexp
{}
2069 bind $w <Visibility
> "
2071 $w.desc.name_t icursor end
2072 focus $w.desc.name_t
2074 bind $w <Key-Escape
> "destroy $w"
2075 bind $w <Key-Return
> "do_create_branch_action $w;break"
2076 wm title
$w "[appname] ([reponame]): Create Branch"
2080 proc do_delete_branch_action
{w
} {
2082 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2085 switch
-- $delete_branch_checktype {
2086 head {set check_rev
$delete_branch_head}
2087 tracking
{set check_rev
$delete_branch_trackinghead}
2088 always
{set check_rev
{:none
}}
2090 if {$check_rev eq
{:none
}} {
2092 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2096 -title [wm title
$w] \
2098 -message "Invalid check revision: $check_rev"
2102 set to_delete
[list
]
2103 set not_merged
[list
]
2104 foreach i
[$w.list.l curselection
] {
2105 set b
[$w.list.l get
$i]
2106 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2107 if {$check_cmt ne
{}} {
2108 if {$b eq
$check_rev} continue
2109 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2111 lappend not_merged
$b
2115 lappend to_delete
[list
$b $o]
2117 if {$not_merged ne
{}} {
2118 set msg
"The following branches are not completely merged into $check_rev:
2120 - [join $not_merged "\n - "]"
2124 -title [wm title
$w] \
2128 if {$to_delete eq
{}} return
2129 if {$delete_branch_checktype eq
{always
}} {
2130 set msg
{Recovering deleted branches is difficult.
2132 Delete the selected branches?
}
2133 if {[tk_messageBox \
2136 -title [wm title
$w] \
2138 -message $msg] ne
yes} {
2144 foreach i
$to_delete {
2147 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2148 append failed
" - $b: $err\n"
2150 set x
[lsearch
-sorted -exact $all_heads $b]
2152 set all_heads
[lreplace
$all_heads $x $x]
2157 if {$failed ne
{}} {
2161 -title [wm title
$w] \
2163 -message "Failed to delete branches:\n$failed"
2166 set all_heads
[lsort
$all_heads]
2167 populate_branch_menu
2171 proc do_delete_branch
{} {
2172 global all_heads tracking_branches current_branch
2173 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2175 set w .branch_editor
2177 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2179 label
$w.header
-text {Delete Local Branch
} \
2181 pack
$w.header
-side top
-fill x
2184 button
$w.buttons.create
-text Delete \
2186 -command [list do_delete_branch_action
$w]
2187 pack
$w.buttons.create
-side right
2188 button
$w.buttons.cancel
-text {Cancel
} \
2190 -command [list destroy
$w]
2191 pack
$w.buttons.cancel
-side right
-padx 5
2192 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2194 labelframe
$w.list \
2195 -text {Local Branches
} \
2200 -selectmode extended \
2201 -yscrollcommand [list
$w.list.sby
set] \
2203 foreach h
$all_heads {
2204 if {$h ne
$current_branch} {
2205 $w.list.l insert end
$h
2208 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2209 pack
$w.list.sby
-side right
-fill y
2210 pack
$w.list.l
-side left
-fill both
-expand 1
2211 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2213 labelframe
$w.validate \
2214 -text {Delete Only If
} \
2216 radiobutton
$w.validate.head_r \
2217 -text {Merged Into Local Branch
:} \
2219 -variable delete_branch_checktype \
2221 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2222 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2223 set all_trackings
[all_tracking_branches
]
2224 if {$all_trackings ne
{}} {
2225 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2226 radiobutton
$w.validate.tracking_r \
2227 -text {Merged Into Tracking Branch
:} \
2229 -variable delete_branch_checktype \
2231 eval tk_optionMenu
$w.validate.tracking_m \
2232 delete_branch_trackinghead \
2234 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2236 radiobutton
$w.validate.always_r \
2237 -text {Always
(Do not perform merge checks
)} \
2239 -variable delete_branch_checktype \
2241 grid
$w.validate.always_r
-columnspan 2 -sticky w
2242 grid columnconfigure
$w.validate
1 -weight 1
2243 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2245 set delete_branch_head
$current_branch
2246 set delete_branch_checktype
head
2248 bind $w <Visibility
> "grab $w; focus $w"
2249 bind $w <Key-Escape
> "destroy $w"
2250 wm title
$w "[appname] ([reponame]): Delete Branch"
2254 proc switch_branch
{new_branch
} {
2255 global HEAD commit_type current_branch repo_config
2257 if {![lock_index switch
]} return
2259 # -- Our in memory state should match the repository.
2261 repository_state curType curHEAD curMERGE_HEAD
2262 if {[string match amend
* $commit_type]
2263 && $curType eq
{normal
}
2264 && $curHEAD eq
$HEAD} {
2265 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2266 info_popup
{Last scanned state does not match repository state.
2268 Another Git program has modified this repository
2269 since the last scan. A rescan must be performed
2270 before the current branch can be changed.
2272 The rescan will be automatically started now.
2275 rescan
{set ui_status_value
{Ready.
}}
2279 # -- Don't do a pointless switch.
2281 if {$current_branch eq
$new_branch} {
2286 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2287 switch_branch_stage2
{} $new_branch
2289 set ui_status_value
{Refreshing
file status...
}
2290 set cmd
[list git update-index
]
2292 lappend cmd
--unmerged
2293 lappend cmd
--ignore-missing
2294 lappend cmd
--refresh
2295 set fd_rf
[open
"| $cmd" r
]
2296 fconfigure
$fd_rf -blocking 0 -translation binary
2297 fileevent
$fd_rf readable \
2298 [list switch_branch_stage2
$fd_rf $new_branch]
2302 proc switch_branch_stage2
{fd_rf new_branch
} {
2303 global ui_status_value HEAD
2307 if {![eof
$fd_rf]} return
2311 set ui_status_value
"Updating working directory to '$new_branch'..."
2312 set cmd
[list git read-tree
]
2315 lappend cmd
--exclude-per-directory=.gitignore
2317 lappend cmd
$new_branch
2318 set fd_rt
[open
"| $cmd" r
]
2319 fconfigure
$fd_rt -blocking 0 -translation binary
2320 fileevent
$fd_rt readable \
2321 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2324 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2325 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2326 global current_branch
2327 global ui_comm ui_status_value
2329 # -- We never get interesting output on stdout; only stderr.
2332 fconfigure
$fd_rt -blocking 1
2333 if {![eof
$fd_rt]} {
2334 fconfigure
$fd_rt -blocking 0
2338 # -- The working directory wasn't in sync with the index and
2339 # we'd have to overwrite something to make the switch. A
2340 # merge is required.
2342 if {[catch
{close
$fd_rt} err
]} {
2343 regsub
{^fatal
: } $err {} err
2344 warn_popup
"File level merge required.
2348 Staying on branch '$current_branch'."
2349 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2354 # -- Update the symbolic ref. Core git doesn't even check for failure
2355 # here, it Just Works(tm). If it doesn't we are in some really ugly
2356 # state that is difficult to recover from within git-gui.
2358 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2359 error_popup
"Failed to set current branch.
2361 This working directory is only partially switched.
2362 We successfully updated your files, but failed to
2363 update an internal Git file.
2365 This should not have occurred. [appname] will now
2373 # -- Update our repository state. If we were previously in amend mode
2374 # we need to toss the current buffer and do a full rescan to update
2375 # our file lists. If we weren't in amend mode our file lists are
2376 # accurate and we can avoid the rescan.
2379 set selected_commit_type new
2380 if {[string match amend
* $commit_type]} {
2381 $ui_comm delete
0.0 end
2383 $ui_comm edit modified false
2384 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2386 repository_state commit_type HEAD MERGE_HEAD
2388 set ui_status_value
"Checked out branch '$current_branch'."
2392 ######################################################################
2394 ## remote management
2396 proc load_all_remotes
{} {
2398 global all_remotes tracking_branches
2400 set all_remotes
[list
]
2401 array
unset tracking_branches
2403 set rm_dir
[gitdir remotes
]
2404 if {[file isdirectory
$rm_dir]} {
2405 set all_remotes
[glob \
2409 -directory $rm_dir *]
2411 foreach name
$all_remotes {
2413 set fd
[open
[file join $rm_dir $name] r
]
2414 while {[gets
$fd line
] >= 0} {
2415 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2416 $line line src dst
]} continue
2417 if {![regexp ^refs
/ $dst]} {
2418 set dst
"refs/heads/$dst"
2420 set tracking_branches
($dst) [list
$name $src]
2427 foreach line
[array names repo_config remote.
*.url
] {
2428 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2429 lappend all_remotes
$name
2431 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2435 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2436 if {![regexp ^refs
/ $dst]} {
2437 set dst
"refs/heads/$dst"
2439 set tracking_branches
($dst) [list
$name $src]
2443 set all_remotes
[lsort
-unique $all_remotes]
2446 proc populate_fetch_menu
{} {
2447 global all_remotes repo_config
2450 foreach r
$all_remotes {
2452 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2453 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2458 set fd
[open
[gitdir remotes
$r] r
]
2459 while {[gets
$fd n
] >= 0} {
2460 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2471 -label "Fetch from $r..." \
2472 -command [list fetch_from
$r] \
2478 proc populate_push_menu
{} {
2479 global all_remotes repo_config
2483 foreach r
$all_remotes {
2485 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2486 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2491 set fd
[open
[gitdir remotes
$r] r
]
2492 while {[gets
$fd n
] >= 0} {
2493 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2507 -label "Push to $r..." \
2508 -command [list push_to
$r] \
2515 proc start_push_anywhere_action
{w
} {
2516 global push_urltype push_remote push_url push_thin push_tags
2519 switch
-- $push_urltype {
2520 remote
{set r_url
$push_remote}
2521 url
{set r_url
$push_url}
2523 if {$r_url eq
{}} return
2525 set cmd
[list git push
]
2535 foreach i
[$w.
source.l curselection
] {
2536 set b
[$w.
source.l get
$i]
2537 lappend cmd
"refs/heads/$b:refs/heads/$b"
2542 } elseif
{$cnt == 1} {
2548 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2549 console_exec
$cons $cmd console_done
2553 trace add variable push_remote
write \
2554 [list radio_selector push_urltype remote
]
2556 proc do_push_anywhere
{} {
2557 global all_heads all_remotes current_branch
2558 global push_urltype push_remote push_url push_thin push_tags
2562 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2564 label
$w.header
-text {Push Branches
} -font font_uibold
2565 pack
$w.header
-side top
-fill x
2568 button
$w.buttons.create
-text Push \
2570 -command [list start_push_anywhere_action
$w]
2571 pack
$w.buttons.create
-side right
2572 button
$w.buttons.cancel
-text {Cancel
} \
2574 -command [list destroy
$w]
2575 pack
$w.buttons.cancel
-side right
-padx 5
2576 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2578 labelframe
$w.
source \
2579 -text {Source Branches
} \
2581 listbox
$w.
source.l \
2584 -selectmode extended \
2585 -yscrollcommand [list
$w.
source.sby
set] \
2587 foreach h
$all_heads {
2588 $w.
source.l insert end
$h
2589 if {$h eq
$current_branch} {
2590 $w.
source.l
select set end
2593 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2594 pack
$w.
source.sby
-side right
-fill y
2595 pack
$w.
source.l
-side left
-fill both
-expand 1
2596 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2598 labelframe
$w.dest \
2599 -text {Destination Repository
} \
2601 if {$all_remotes ne
{}} {
2602 radiobutton
$w.dest.remote_r \
2605 -variable push_urltype \
2607 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2608 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2609 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2610 set push_remote origin
2612 set push_remote
[lindex
$all_remotes 0]
2614 set push_urltype remote
2616 set push_urltype url
2618 radiobutton
$w.dest.url_r \
2619 -text {Arbitrary URL
:} \
2621 -variable push_urltype \
2623 entry
$w.dest.url_t \
2627 -textvariable push_url \
2631 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2632 if {%d
== 1 && [string length
%S
] > 0} {
2633 set push_urltype url
2637 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2638 grid columnconfigure
$w.dest
1 -weight 1
2639 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2641 labelframe
$w.options \
2642 -text {Transfer Options
} \
2644 checkbutton
$w.options.thin \
2645 -text {Use thin pack
(for slow network connections
)} \
2646 -variable push_thin \
2648 grid
$w.options.thin
-columnspan 2 -sticky w
2649 checkbutton
$w.options.tags \
2650 -text {Include tags
} \
2651 -variable push_tags \
2653 grid
$w.options.tags
-columnspan 2 -sticky w
2654 grid columnconfigure
$w.options
1 -weight 1
2655 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2661 bind $w <Visibility
> "grab $w"
2662 bind $w <Key-Escape
> "destroy $w"
2663 wm title
$w "[appname] ([reponame]): Push"
2667 ######################################################################
2672 global HEAD commit_type file_states
2674 if {[string match amend
* $commit_type]} {
2675 info_popup
{Cannot merge
while amending.
2677 You must finish amending this commit before
2678 starting any
type of merge.
2683 if {[committer_ident
] eq
{}} {return 0}
2684 if {![lock_index merge
]} {return 0}
2686 # -- Our in memory state should match the repository.
2688 repository_state curType curHEAD curMERGE_HEAD
2689 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2690 info_popup
{Last scanned state does not match repository state.
2692 Another Git program has modified this repository
2693 since the last scan. A rescan must be performed
2694 before a merge can be performed.
2696 The rescan will be automatically started now.
2699 rescan
{set ui_status_value
{Ready.
}}
2703 foreach path
[array names file_states
] {
2704 switch
-glob -- [lindex
$file_states($path) 0] {
2706 continue; # and pray it works!
2709 error_popup
"You are in the middle of a conflicted merge.
2711 File [short_path $path] has merge conflicts.
2713 You must resolve them, add the file, and commit to
2714 complete the current merge. Only then can you
2715 begin another merge.
2721 error_popup
"You are in the middle of a change.
2723 File [short_path $path] is modified.
2725 You should complete the current commit before
2726 starting a merge. Doing so will help you abort
2727 a failed merge, should the need arise.
2738 proc visualize_local_merge
{w
} {
2740 foreach i
[$w.
source.l curselection
] {
2741 lappend revs
[$w.
source.l get
$i]
2743 if {$revs eq
{}} return
2744 lappend revs
--not HEAD
2748 proc start_local_merge_action
{w
} {
2749 global HEAD ui_status_value current_branch
2751 set cmd
[list git merge
]
2754 foreach i
[$w.
source.l curselection
] {
2755 set b
[$w.
source.l get
$i]
2763 } elseif
{$revcnt == 1} {
2765 } elseif
{$revcnt <= 15} {
2771 -title [wm title
$w] \
2773 -message "Too many branches selected.
2775 You have requested to merge $revcnt branches
2776 in an octopus merge. This exceeds Git's
2777 internal limit of 15 branches per merge.
2779 Please select fewer branches. To merge more
2780 than 15 branches, merge the branches in batches.
2785 set msg
"Merging $current_branch, [join $names {, }]"
2786 set ui_status_value
"$msg..."
2787 set cons
[new_console
"Merge" $msg]
2788 console_exec
$cons $cmd [list finish_merge
$revcnt]
2789 bind $w <Destroy
> {}
2793 proc finish_merge
{revcnt w ok
} {
2796 set msg
{Merge completed successfully.
}
2799 info_popup
"Octopus merge failed.
2801 Your merge of $revcnt branches has failed.
2803 There are file-level conflicts between the
2804 branches which must be resolved manually.
2806 The working directory will now be reset.
2808 You can attempt this merge again
2809 by merging only one branch at a time." $w
2811 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2812 fconfigure
$fd -blocking 0 -translation binary
2813 fileevent
$fd readable
[list reset_hard_wait
$fd]
2814 set ui_status_value
{Aborting... please
wait...
}
2818 set msg
{Merge failed. Conflict resolution is required.
}
2821 rescan
[list
set ui_status_value
$msg]
2824 proc do_local_merge
{} {
2825 global current_branch
2827 if {![can_merge
]} return
2831 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2834 -text "Merge Into $current_branch" \
2836 pack
$w.header
-side top
-fill x
2839 button
$w.buttons.visualize
-text Visualize \
2841 -command [list visualize_local_merge
$w]
2842 pack
$w.buttons.visualize
-side left
2843 button
$w.buttons.create
-text Merge \
2845 -command [list start_local_merge_action
$w]
2846 pack
$w.buttons.create
-side right
2847 button
$w.buttons.cancel
-text {Cancel
} \
2849 -command [list destroy
$w]
2850 pack
$w.buttons.cancel
-side right
-padx 5
2851 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2853 labelframe
$w.
source \
2854 -text {Source Branches
} \
2856 listbox
$w.
source.l \
2859 -selectmode extended \
2860 -yscrollcommand [list
$w.
source.sby
set] \
2862 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2863 pack
$w.
source.sby
-side right
-fill y
2864 pack
$w.
source.l
-side left
-fill both
-expand 1
2865 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2867 set cmd
[list git for-each-ref
]
2868 lappend cmd
{--format=%(objectname
) %(refname
)}
2869 lappend cmd refs
/heads
2870 lappend cmd refs
/remotes
2871 set fr_fd
[open
"| $cmd" r
]
2872 fconfigure
$fr_fd -translation binary
2873 while {[gets
$fr_fd line
] > 0} {
2874 set line
[split $line { }]
2875 set sha1
([lindex
$line 0]) [lindex
$line 1]
2880 set fr_fd
[open
"| git rev-list --all --not HEAD"]
2881 while {[gets
$fr_fd line
] > 0} {
2882 if {[catch
{set ref
$sha1($line)}]} continue
2883 regsub ^refs
/(heads|remotes
)/ $ref {} ref
2884 lappend to_show
$ref
2888 foreach ref
[lsort
-unique $to_show] {
2889 $w.
source.l insert end
$ref
2892 bind $w <Visibility
> "grab $w"
2893 bind $w <Key-Escape
> "unlock_index;destroy $w"
2894 bind $w <Destroy
> unlock_index
2895 wm title
$w "[appname] ([reponame]): Merge"
2899 proc do_reset_hard
{} {
2900 global HEAD commit_type file_states
2902 if {[string match amend
* $commit_type]} {
2903 info_popup
{Cannot abort
while amending.
2905 You must finish amending this commit.
2910 if {![lock_index abort
]} return
2912 if {[string match
*merge
* $commit_type]} {
2918 if {[ask_popup
"Abort $op?
2920 Aborting the current $op will cause
2921 *ALL* uncommitted changes to be lost.
2923 Continue with aborting the current $op?"] eq
{yes}} {
2924 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2925 fconfigure
$fd -blocking 0 -translation binary
2926 fileevent
$fd readable
[list reset_hard_wait
$fd]
2927 set ui_status_value
{Aborting... please
wait...
}
2933 proc reset_hard_wait
{fd
} {
2941 $ui_comm delete
0.0 end
2942 $ui_comm edit modified false
2944 catch
{file delete
[gitdir MERGE_HEAD
]}
2945 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
2946 catch
{file delete
[gitdir SQUASH_MSG
]}
2947 catch
{file delete
[gitdir MERGE_MSG
]}
2948 catch
{file delete
[gitdir GITGUI_MSG
]}
2950 rescan
{set ui_status_value
{Abort completed. Ready.
}}
2954 ######################################################################
2958 set next_browser_id
0
2960 proc new_browser
{commit
} {
2961 global next_browser_id cursor_ptr M1B
2962 global browser_commit browser_status browser_stack browser_path browser_busy
2964 set w .browser
[incr next_browser_id
]
2965 set w_list
$w.list.l
2966 set browser_commit
($w_list) $commit
2967 set browser_status
($w_list) {Starting...
}
2968 set browser_stack
($w_list) {}
2969 set browser_path
($w_list) $browser_commit($w_list):
2970 set browser_busy
($w_list) 1
2973 label
$w.path
-textvariable browser_path
($w_list) \
2979 pack
$w.path
-anchor w
-side top
-fill x
2982 text
$w_list -background white
-borderwidth 0 \
2983 -cursor $cursor_ptr \
2988 -xscrollcommand [list
$w.list.sbx
set] \
2989 -yscrollcommand [list
$w.list.sby
set] \
2991 $w_list tag conf in_sel \
2992 -background [$w_list cget
-foreground] \
2993 -foreground [$w_list cget
-background]
2994 scrollbar
$w.list.sbx
-orient h
-command [list
$w_list xview
]
2995 scrollbar
$w.list.sby
-orient v
-command [list
$w_list yview
]
2996 pack
$w.list.sbx
-side bottom
-fill x
2997 pack
$w.list.sby
-side right
-fill y
2998 pack
$w_list -side left
-fill both
-expand 1
2999 pack
$w.list
-side top
-fill both
-expand 1
3001 label
$w.status
-textvariable browser_status
($w_list) \
3007 pack
$w.status
-anchor w
-side bottom
-fill x
3009 bind $w_list <Button-1
> "browser_click 0 $w_list @%x,%y;break"
3010 bind $w_list <Double-Button-1
> "browser_click 1 $w_list @%x,%y;break"
3011 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3012 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3013 bind $w_list <Up
> "browser_move -1 $w_list;break"
3014 bind $w_list <Down
> "browser_move 1 $w_list;break"
3015 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3016 bind $w_list <Return
> "browser_enter $w_list;break"
3017 bind $w_list <Prior
> "browser_page -1 $w_list;break"
3018 bind $w_list <Next
> "browser_page 1 $w_list;break"
3019 bind $w_list <Left
> break
3020 bind $w_list <Right
> break
3022 bind $w <Visibility
> "focus $w"
3024 array unset browser_buffer $w_list
3025 array unset browser_files $w_list
3026 array unset browser_status $w_list
3027 array unset browser_stack $w_list
3028 array unset browser_path $w_list
3029 array unset browser_commit $w_list
3030 array unset browser_busy $w_list
3032 wm title
$w "[appname] ([reponame]): File Browser"
3033 ls_tree
$w_list $browser_commit($w_list) {}
3036 proc browser_move
{dir w
} {
3037 global browser_files browser_busy
3039 if {$browser_busy($w)} return
3040 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3042 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3043 $w tag remove in_sel
0.0 end
3044 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3049 proc browser_page
{dir w
} {
3050 global browser_files browser_busy
3052 if {$browser_busy($w)} return
3053 $w yview scroll
$dir pages
3055 [lindex
[$w yview
] 0]
3056 * [llength
$browser_files($w)]
3058 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3059 $w tag remove in_sel
0.0 end
3060 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3065 proc browser_parent
{w
} {
3066 global browser_files browser_status browser_path
3067 global browser_stack browser_busy
3069 if {$browser_busy($w)} return
3070 set info
[lindex
$browser_files($w) 0]
3071 if {[lindex
$info 0] eq
{parent
}} {
3072 set parent
[lindex
$browser_stack($w) end-1
]
3073 set browser_stack
($w) [lrange
$browser_stack($w) 0 end-2
]
3074 if {$browser_stack($w) eq
{}} {
3075 regsub
{:.
*$
} $browser_path($w) {:} browser_path
($w)
3077 regsub
{/[^
/]+$
} $browser_path($w) {} browser_path
($w)
3079 set browser_status
($w) "Loading $browser_path($w)..."
3080 ls_tree
$w [lindex
$parent 0] [lindex
$parent 1]
3084 proc browser_enter
{w
} {
3085 global browser_files browser_status browser_path
3086 global browser_commit browser_stack browser_busy
3088 if {$browser_busy($w)} return
3089 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3090 set info
[lindex
$browser_files($w) [expr {$lno - 1}]]
3092 switch
-- [lindex
$info 0] {
3097 set name
[lindex
$info 2]
3098 set escn
[escape_path
$name]
3099 set browser_status
($w) "Loading $escn..."
3100 append browser_path
($w) $escn
3101 ls_tree
$w [lindex
$info 1] $name
3104 set name
[lindex
$info 2]
3106 foreach n
$browser_stack($w) {
3107 append p
[lindex
$n 1]
3110 show_blame
$browser_commit($w) $p
3116 proc browser_click
{was_double_click w pos
} {
3117 global browser_files browser_busy
3119 if {$browser_busy($w)} return
3120 set lno
[lindex
[split [$w index
$pos] .
] 0]
3123 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3124 $w tag remove in_sel
0.0 end
3125 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3126 if {$was_double_click} {
3132 proc ls_tree
{w tree_id name
} {
3133 global browser_buffer browser_files browser_stack browser_busy
3135 set browser_buffer
($w) {}
3136 set browser_files
($w) {}
3137 set browser_busy
($w) 1
3139 $w conf
-state normal
3140 $w tag remove in_sel
0.0 end
3142 if {$browser_stack($w) ne
{}} {
3143 $w image create end \
3144 -align center
-padx 5 -pady 1 \
3147 $w insert end
{[Up To Parent
]}
3148 lappend browser_files
($w) parent
3150 lappend browser_stack
($w) [list
$tree_id $name]
3151 $w conf
-state disabled
3153 set cmd
[list git ls-tree
-z $tree_id]
3154 set fd
[open
"| $cmd" r
]
3155 fconfigure
$fd -blocking 0 -translation binary
-encoding binary
3156 fileevent
$fd readable
[list read_ls_tree
$fd $w]
3159 proc read_ls_tree
{fd w
} {
3160 global browser_buffer browser_files browser_status browser_busy
3162 if {![winfo exists
$w]} {
3167 append browser_buffer
($w) [read $fd]
3168 set pck
[split $browser_buffer($w) "\0"]
3169 set browser_buffer
($w) [lindex
$pck end
]
3171 set n
[llength
$browser_files($w)]
3172 $w conf
-state normal
3173 foreach p
[lrange
$pck 0 end-1
] {
3174 set info
[split $p "\t"]
3175 set path
[lindex
$info 1]
3176 set info
[split [lindex
$info 0] { }]
3177 set type [lindex
$info 1]
3178 set object
[lindex
$info 2]
3189 set image file_question
3193 if {$n > 0} {$w insert end
"\n"}
3194 $w image create end \
3195 -align center
-padx 5 -pady 1 \
3196 -name icon
[incr n
] \
3198 $w insert end
[escape_path
$path]
3199 lappend browser_files
($w) [list
$type $object $path]
3201 $w conf
-state disabled
3205 set browser_status
($w) Ready.
3206 set browser_busy
($w) 0
3207 array
unset browser_buffer
$w
3209 $w tag add in_sel
1.0 2.0
3215 proc show_blame
{commit path
} {
3216 global next_browser_id blame_status blame_data
3218 set w .browser
[incr next_browser_id
]
3219 set blame_status
($w) {Loading current
file content...
}
3224 label
$w.path
-text "$commit:$path" \
3230 pack
$w.path
-side top
-fill x
3234 label
$w.out.commit_l
-text Commit \
3239 text
$w.out.commit_t \
3240 -background white
-borderwidth 0 \
3246 lappend texts
$w.out.commit_t
3248 label
$w.out.author_l
-text Author \
3253 text
$w.out.author_t \
3254 -background white
-borderwidth 0 \
3260 lappend texts
$w.out.author_t
3262 label
$w.out.date_l
-text Date \
3267 text
$w.out.date_t \
3268 -background white
-borderwidth 0 \
3272 -width [string length
"yyyy-mm-dd hh:mm:ss"] \
3274 lappend texts
$w.out.date_t
3276 label
$w.out.filename_l
-text Filename \
3281 text
$w.out.filename_t \
3282 -background white
-borderwidth 0 \
3288 lappend texts
$w.out.filename_t
3290 label
$w.out.origlinenumber_l
-text {Orig Line
} \
3295 text
$w.out.origlinenumber_t \
3296 -background white
-borderwidth 0 \
3302 $w.out.origlinenumber_t tag conf linenumber
-justify right
3303 lappend texts
$w.out.origlinenumber_t
3305 label
$w.out.linenumber_l
-text {Curr Line
} \
3310 text
$w.out.linenumber_t \
3311 -background white
-borderwidth 0 \
3317 $w.out.linenumber_t tag conf linenumber
-justify right
3318 lappend texts
$w.out.linenumber_t
3320 label
$w.out.file_l
-text {File Content
} \
3325 text
$w.out.file_t \
3326 -background white
-borderwidth 0 \
3331 -xscrollcommand [list
$w.out.sbx
set] \
3333 lappend texts
$w.out.file_t
3335 scrollbar
$w.out.sbx
-orient h
-command [list
$w.out.file_t xview
]
3336 scrollbar
$w.out.sby
-orient v \
3337 -command [list scrollbar2many
$texts yview
]
3340 regsub
{_t$
} $i _l l
3343 set file_col
[expr {[llength
$texts] - 1}]
3344 eval grid
$labels -sticky we
3345 eval grid
$texts $w.out.sby
-sticky nsew
3346 grid conf
$w.out.sbx
-column $file_col -sticky we
3347 grid columnconfigure
$w.out
$file_col -weight 1
3348 grid rowconfigure
$w.out
1 -weight 1
3349 pack
$w.out
-fill both
-expand 1
3351 label
$w.status
-textvariable blame_status
($w) \
3357 pack
$w.status
-side bottom
-fill x
3359 menu
$w.ctxm
-tearoff 0
3360 $w.ctxm add
command -label "Copy Commit" \
3362 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3365 $i tag conf in_sel \
3366 -background [$i cget
-foreground] \
3367 -foreground [$i cget
-background]
3368 $i conf
-yscrollcommand \
3369 [list many2scrollbar
$texts yview
$w.out.sby
]
3370 bind $i <Button-1
> "blame_highlight $i @%x,%y $texts;break"
3375 tk_popup $w.ctxm %X %Y
3379 set blame_data
($w,colors
) {}
3381 bind $w <Visibility
> "focus $w"
3383 array unset blame_status $w
3384 array unset blame_data $w,*
3386 wm title
$w "[appname] ([reponame]): File Viewer"
3388 set blame_data
($w,total_lines
) 0
3389 set cmd
[list git cat-file blob
"$commit:$path"]
3390 set fd
[open
"| $cmd" r
]
3391 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3392 fileevent
$fd readable
[list read_blame_catfile \
3393 $fd $w $commit $path \
3394 $texts $w.out.linenumber_t
$w.out.file_t
]
3397 proc read_blame_catfile
{fd w commit path texts w_lno w_file
} {
3398 global blame_status blame_data
3400 if {![winfo exists
$w_file]} {
3405 set n
$blame_data($w,total_lines
)
3406 foreach i
$texts {$i conf
-state normal
}
3407 while {[gets
$fd line
] >= 0} {
3408 regsub
"\r\$" $line {} line
3410 $w_lno insert end
$n linenumber
3411 $w_file insert end
$line
3412 foreach i
$texts {$i insert end
"\n"}
3414 foreach i
$texts {$i conf
-state disabled
}
3415 set blame_data
($w,total_lines
) $n
3419 set blame_status
($w) {Loading annotations...
}
3420 set cmd
[list git blame
-M -C --incremental]
3421 lappend cmd
$commit -- $path
3422 set fd
[open
"| $cmd" r
]
3423 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3424 fileevent
$fd readable
"read_blame_incremental $fd $w $texts"
3428 proc read_blame_incremental
{fd w
3429 w_commit w_author w_date w_filename w_olno
3431 global blame_status blame_data
3433 if {![winfo exists
$w_commit]} {
3447 $w_commit conf
-state normal
3448 $w_author conf
-state normal
3449 $w_date conf
-state normal
3450 $w_filename conf
-state normal
3451 $w_olno conf
-state normal
3453 while {[gets
$fd line
] >= 0} {
3454 if {[regexp
{^
([a-z0-9
]{40}) (\d
+) (\d
+) (\d
+)$
} $line line \
3455 cmit original_line final_line line_count
]} {
3456 set blame_data
($w,commit
) $cmit
3457 set blame_data
($w,original_line
) $original_line
3458 set blame_data
($w,final_line
) $final_line
3459 set blame_data
($w,line_count
) $line_count
3461 if {[catch
{set g
$blame_data($w,$cmit,seen
)}]} {
3462 if {$blame_data($w,colors
) eq
{}} {
3463 set blame_data
($w,colors
) {
3472 set c
[lindex
$blame_data($w,colors
) 0]
3473 set blame_data
($w,colors
) \
3474 [lrange
$blame_data($w,colors
) 1 end
]
3476 $t tag conf g
$cmit -background $c
3479 set blame_data
($w,$cmit,seen
) 1
3481 } elseif
{[string match
{filename
*} $line]} {
3482 set n
$blame_data($w,line_count
)
3483 set lno
$blame_data($w,final_line
)
3484 set ol
$blame_data($w,original_line
)
3485 set file [string range
$line 9 end
]
3486 set cmit
$blame_data($w,commit
)
3487 set abbrev
[string range
$cmit 0 8]
3489 if {[catch
{set author
$blame_data($w,$cmit,author
)} err
]} {
3493 if {[catch
{set atime
$blame_data($w,$cmit,author-time
)}]} {
3496 set atime
[clock format
$atime -format {%Y-
%m-
%d
%T
}]
3500 if {![catch
{set g g
$blame_data($w,line
$lno,commit
)}]} {
3502 $t tag remove
$g $lno.0 "$lno.0 lineend + 1c"
3512 $t delete
$lno.0 "$lno.0 lineend"
3515 $w_commit insert
$lno.0 $abbrev
3516 $w_author insert
$lno.0 $author
3517 $w_date insert
$lno.0 $atime
3518 $w_filename insert
$lno.0 $file
3519 $w_olno insert
$lno.0 $ol linenumber
3523 $t tag add
$g $lno.0 "$lno.0 lineend + 1c"
3526 set blame_data
($w,line
$lno,commit
) $cmit
3532 } elseif
{[regexp
{^
([a-z-
]+) (.
*)$
} $line line header data
]} {
3533 set blame_data
($w,$blame_data($w,commit
),$header) $data
3537 $w_commit conf
-state disabled
3538 $w_author conf
-state disabled
3539 $w_date conf
-state disabled
3540 $w_filename conf
-state disabled
3541 $w_olno conf
-state disabled
3545 set blame_status
($w) {Annotation complete.
}
3549 proc blame_highlight
{w pos args
} {
3550 set lno
[lindex
[split [$w index
$pos] .
] 0]
3552 $i tag remove in_sel
0.0 end
3554 if {$lno eq
{}} return
3556 $i tag add in_sel
$lno.0 "$lno.0 + 1 line"
3560 proc blame_copycommit
{w i pos
} {
3562 set lno
[lindex
[split [$i index
$pos] .
] 0]
3563 if {![catch
{set commit
$blame_data($w,line
$lno,commit
)}]} {
3572 ######################################################################
3577 #define mask_width 14
3578 #define mask_height 15
3579 static unsigned char mask_bits
[] = {
3580 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3581 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3582 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3585 image create bitmap file_plain
-background white
-foreground black
-data {
3586 #define plain_width 14
3587 #define plain_height 15
3588 static unsigned char plain_bits
[] = {
3589 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3590 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3591 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3592 } -maskdata $filemask
3594 image create bitmap file_mod
-background white
-foreground blue
-data {
3595 #define mod_width 14
3596 #define mod_height 15
3597 static unsigned char mod_bits
[] = {
3598 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3599 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3600 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3601 } -maskdata $filemask
3603 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
3604 #define file_fulltick_width 14
3605 #define file_fulltick_height 15
3606 static unsigned char file_fulltick_bits
[] = {
3607 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3608 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3609 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3610 } -maskdata $filemask
3612 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
3613 #define parttick_width 14
3614 #define parttick_height 15
3615 static unsigned char parttick_bits
[] = {
3616 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3617 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3618 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3619 } -maskdata $filemask
3621 image create bitmap file_question
-background white
-foreground black
-data {
3622 #define file_question_width 14
3623 #define file_question_height 15
3624 static unsigned char file_question_bits
[] = {
3625 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3626 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3627 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3628 } -maskdata $filemask
3630 image create bitmap file_removed
-background white
-foreground red
-data {
3631 #define file_removed_width 14
3632 #define file_removed_height 15
3633 static unsigned char file_removed_bits
[] = {
3634 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3635 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3636 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3637 } -maskdata $filemask
3639 image create bitmap file_merge
-background white
-foreground blue
-data {
3640 #define file_merge_width 14
3641 #define file_merge_height 15
3642 static unsigned char file_merge_bits
[] = {
3643 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3644 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3645 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3646 } -maskdata $filemask
3649 #define file_width 18
3650 #define file_height 18
3651 static unsigned char file_bits
[] = {
3652 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3653 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3654 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3655 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3656 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3658 image create bitmap file_dir
-background white
-foreground blue \
3659 -data $file_dir_data -maskdata $file_dir_data
3662 set file_uplevel_data
{
3664 #define up_height 15
3665 static unsigned char up_bits
[] = {
3666 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3667 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3668 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3670 image create bitmap file_uplevel
-background white
-foreground red \
3671 -data $file_uplevel_data -maskdata $file_uplevel_data
3672 unset file_uplevel_data
3674 set ui_index .vpane.files.index.list
3675 set ui_workdir .vpane.files.workdir.list
3677 set all_icons
(_
$ui_index) file_plain
3678 set all_icons
(A
$ui_index) file_fulltick
3679 set all_icons
(M
$ui_index) file_fulltick
3680 set all_icons
(D
$ui_index) file_removed
3681 set all_icons
(U
$ui_index) file_merge
3683 set all_icons
(_
$ui_workdir) file_plain
3684 set all_icons
(M
$ui_workdir) file_mod
3685 set all_icons
(D
$ui_workdir) file_question
3686 set all_icons
(U
$ui_workdir) file_merge
3687 set all_icons
(O
$ui_workdir) file_plain
3689 set max_status_desc
0
3693 {_M
"Modified, not staged"}
3694 {M_
"Staged for commit"}
3695 {MM
"Portions staged for commit"}
3696 {MD
"Staged for commit, missing"}
3698 {_O
"Untracked, not staged"}
3699 {A_
"Staged for commit"}
3700 {AM
"Portions staged for commit"}
3701 {AD
"Staged for commit, missing"}
3704 {D_
"Staged for removal"}
3705 {DO
"Staged for removal, still present"}
3707 {U_
"Requires merge resolution"}
3708 {UU
"Requires merge resolution"}
3709 {UM
"Requires merge resolution"}
3710 {UD
"Requires merge resolution"}
3712 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3713 set max_status_desc
[string length
[lindex
$i 1]]
3715 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3719 ######################################################################
3723 proc bind_button3
{w cmd
} {
3724 bind $w <Any-Button-3
> $cmd
3726 bind $w <Control-Button-1
> $cmd
3730 proc scrollbar2many
{list mode args
} {
3731 foreach w
$list {eval $w $mode $args}
3734 proc many2scrollbar
{list mode sb top bottom
} {
3735 $sb set $top $bottom
3736 foreach w
$list {$w $mode moveto
$top}
3739 proc incr_font_size
{font
{amt
1}} {
3740 set sz
[font configure
$font -size]
3742 font configure
$font -size $sz
3743 font configure
${font}bold
-size $sz
3746 proc hook_failed_popup
{hook msg
} {
3751 label
$w.m.l1
-text "$hook hook failed:" \
3756 -background white
-borderwidth 1 \
3758 -width 80 -height 10 \
3760 -yscrollcommand [list
$w.m.sby
set]
3762 -text {You must correct the above errors before committing.
} \
3766 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3767 pack
$w.m.l1
-side top
-fill x
3768 pack
$w.m.l2
-side bottom
-fill x
3769 pack
$w.m.sby
-side right
-fill y
3770 pack
$w.m.t
-side left
-fill both
-expand 1
3771 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3773 $w.m.t insert
1.0 $msg
3774 $w.m.t conf
-state disabled
3776 button
$w.ok
-text OK \
3779 -command "destroy $w"
3780 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3782 bind $w <Visibility
> "grab $w; focus $w"
3783 bind $w <Key-Return
> "destroy $w"
3784 wm title
$w "[appname] ([reponame]): error"
3788 set next_console_id
0
3790 proc new_console
{short_title long_title
} {
3791 global next_console_id console_data
3792 set w .console
[incr next_console_id
]
3793 set console_data
($w) [list
$short_title $long_title]
3794 return [console_init
$w]
3797 proc console_init
{w
} {
3798 global console_cr console_data M1B
3800 set console_cr
($w) 1.0
3803 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3808 -background white
-borderwidth 1 \
3810 -width 80 -height 10 \
3813 -yscrollcommand [list
$w.m.sby
set]
3814 label
$w.m.s
-text {Working... please
wait...
} \
3818 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3819 pack
$w.m.l1
-side top
-fill x
3820 pack
$w.m.s
-side bottom
-fill x
3821 pack
$w.m.sby
-side right
-fill y
3822 pack
$w.m.t
-side left
-fill both
-expand 1
3823 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3825 menu
$w.ctxm
-tearoff 0
3826 $w.ctxm add
command -label "Copy" \
3828 -command "tk_textCopy $w.m.t"
3829 $w.ctxm add
command -label "Select All" \
3831 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3832 $w.ctxm add
command -label "Copy All" \
3835 $w.m.t tag add sel 0.0 end
3837 $w.m.t tag remove sel 0.0 end
3840 button
$w.ok
-text {Close
} \
3843 -command "destroy $w"
3844 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3846 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
3847 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3848 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3849 bind $w <Visibility
> "focus $w"
3850 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3854 proc console_exec
{w cmd after
} {
3855 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3856 # But most users need that so we have to relogin. :-(
3859 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
3862 # -- Tcl won't let us redirect both stdout and stderr to
3863 # the same pipe. So pass it through cat...
3865 set cmd
[concat |
$cmd |
& cat]
3867 set fd_f
[open
$cmd r
]
3868 fconfigure
$fd_f -blocking 0 -translation binary
3869 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
3872 proc console_read
{w fd after
} {
3877 if {![winfo exists
$w]} {console_init
$w}
3878 $w.m.t conf
-state normal
3880 set n
[string length
$buf]
3882 set cr
[string first
"\r" $buf $c]
3883 set lf
[string first
"\n" $buf $c]
3884 if {$cr < 0} {set cr
[expr {$n + 1}]}
3885 if {$lf < 0} {set lf
[expr {$n + 1}]}
3888 $w.m.t insert end
[string range
$buf $c $lf]
3889 set console_cr
($w) [$w.m.t index
{end
-1c}]
3893 $w.m.t delete
$console_cr($w) end
3894 $w.m.t insert end
"\n"
3895 $w.m.t insert end
[string range
$buf $c $cr]
3900 $w.m.t conf
-state disabled
3904 fconfigure
$fd -blocking 1
3906 if {[catch
{close
$fd}]} {
3911 uplevel
#0 $after $w $ok
3914 fconfigure
$fd -blocking 0
3917 proc console_chain
{cmdlist w
{ok
1}} {
3919 if {[llength
$cmdlist] == 0} {
3924 set cmd
[lindex
$cmdlist 0]
3925 set cmdlist
[lrange
$cmdlist 1 end
]
3927 if {[lindex
$cmd 0] eq
{console_exec
}} {
3930 [list console_chain
$cmdlist]
3932 uplevel
#0 $cmd $cmdlist $w $ok
3939 proc console_done
{args
} {
3940 global console_cr console_data
3942 switch
-- [llength
$args] {
3944 set w
[lindex
$args 0]
3945 set ok
[lindex
$args 1]
3948 set w
[lindex
$args 1]
3949 set ok
[lindex
$args 2]
3952 error
"wrong number of args: console_done ?ignored? w ok"
3957 if {[winfo exists
$w]} {
3958 $w.m.s conf
-background green
-text {Success
}
3959 $w.ok conf
-state normal
3962 if {![winfo exists
$w]} {
3965 $w.m.s conf
-background red
-text {Error
: Command Failed
}
3966 $w.ok conf
-state normal
3969 array
unset console_cr
$w
3970 array
unset console_data
$w
3973 ######################################################################
3977 set starting_gitk_msg
{Starting gitk... please
wait...
}
3979 proc do_gitk
{revs
} {
3980 global env ui_status_value starting_gitk_msg
3982 # -- On Windows gitk is severly broken, and right now it seems like
3983 # nobody cares about fixing it. The only known workaround is to
3984 # always delete ~/.gitk before starting the program.
3987 catch
{file delete
[file join $env(HOME
) .gitk
]}
3990 # -- Always start gitk through whatever we were loaded with. This
3991 # lets us bypass using shell process on Windows systems.
3993 set cmd
[info nameofexecutable
]
3994 lappend cmd
[gitexec gitk
]
4000 if {[catch
{eval exec $cmd &} err
]} {
4001 error_popup
"Failed to start gitk:\n\n$err"
4003 set ui_status_value
$starting_gitk_msg
4005 if {$ui_status_value eq
$starting_gitk_msg} {
4006 set ui_status_value
{Ready.
}
4013 set fd
[open
"| git count-objects -v" r
]
4014 while {[gets
$fd line
] > 0} {
4015 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
4016 set stats
($name) $value
4022 foreach p
[glob
-directory [gitdir objects pack
] \
4025 incr packed_sz
[file size
$p]
4027 if {$packed_sz > 0} {
4028 set stats
(size-pack
) [expr {$packed_sz / 1024}]
4033 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4035 label
$w.header
-text {Database Statistics
} \
4037 pack
$w.header
-side top
-fill x
4039 frame
$w.buttons
-border 1
4040 button
$w.buttons.close
-text Close \
4042 -command [list destroy
$w]
4043 button
$w.buttons.gc
-text {Compress Database
} \
4045 -command "destroy $w;do_gc"
4046 pack
$w.buttons.close
-side right
4047 pack
$w.buttons.gc
-side left
4048 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4050 frame
$w.stat
-borderwidth 1 -relief solid
4052 {count
{Number of loose objects
}}
4053 {size
{Disk space used by loose objects
} { KiB
}}
4054 {in-pack
{Number of packed objects
}}
4055 {packs
{Number of packs
}}
4056 {size-pack
{Disk space used by packed objects
} { KiB
}}
4057 {prune-packable
{Packed objects waiting
for pruning
}}
4058 {garbage
{Garbage files
}}
4060 set name
[lindex
$s 0]
4061 set label
[lindex
$s 1]
4062 if {[catch
{set value
$stats($name)}]} continue
4063 if {[llength
$s] > 2} {
4064 set value
"$value[lindex $s 2]"
4067 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
4068 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
4069 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
4071 pack
$w.stat
-pady 10 -padx 10
4073 bind $w <Visibility
> "grab $w; focus $w"
4074 bind $w <Key-Escape
> [list destroy
$w]
4075 bind $w <Key-Return
> [list destroy
$w]
4076 wm title
$w "[appname] ([reponame]): Database Statistics"
4081 set w
[new_console
{gc
} {Compressing the object database
}]
4083 {console_exec
{git pack-refs
--prune}}
4084 {console_exec
{git reflog expire
--all}}
4085 {console_exec
{git repack
-a -d -l}}
4086 {console_exec
{git rerere gc
}}
4090 proc do_fsck_objects
{} {
4091 set w
[new_console
{fsck-objects
} \
4092 {Verifying the object database with fsck-objects
}]
4093 set cmd
[list git fsck-objects
]
4096 lappend cmd
--strict
4097 console_exec
$w $cmd console_done
4103 global ui_comm is_quitting repo_config commit_type
4105 if {$is_quitting} return
4108 # -- Stash our current commit buffer.
4110 set save
[gitdir GITGUI_MSG
]
4111 set msg
[string trim
[$ui_comm get
0.0 end
]]
4112 regsub
-all -line {[ \r\t]+$
} $msg {} msg
4113 if {(![string match amend
* $commit_type]
4114 ||
[$ui_comm edit modified
])
4117 set fd
[open
$save w
]
4118 puts
-nonewline $fd $msg
4122 catch
{file delete
$save}
4125 # -- Stash our current window geometry into this repository.
4127 set cfg_geometry
[list
]
4128 lappend cfg_geometry
[wm geometry .
]
4129 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
4130 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
4131 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
4134 if {$cfg_geometry ne
$rc_geometry} {
4135 catch
{exec git repo-config gui.geometry
$cfg_geometry}
4142 rescan
{set ui_status_value
{Ready.
}}
4145 proc unstage_helper
{txt paths
} {
4146 global file_states current_diff_path
4148 if {![lock_index begin-update
]} return
4152 foreach path
$paths {
4153 switch
-glob -- [lindex
$file_states($path) 0] {
4157 lappend pathList
$path
4158 if {$path eq
$current_diff_path} {
4159 set after
{reshow_diff
;}
4164 if {$pathList eq
{}} {
4170 [concat
$after {set ui_status_value
{Ready.
}}]
4174 proc do_unstage_selection
{} {
4175 global current_diff_path selected_paths
4177 if {[array size selected_paths
] > 0} {
4179 {Unstaging selected files from commit
} \
4180 [array names selected_paths
]
4181 } elseif
{$current_diff_path ne
{}} {
4183 "Unstaging [short_path $current_diff_path] from commit" \
4184 [list
$current_diff_path]
4188 proc add_helper
{txt paths
} {
4189 global file_states current_diff_path
4191 if {![lock_index begin-update
]} return
4195 foreach path
$paths {
4196 switch
-glob -- [lindex
$file_states($path) 0] {
4201 lappend pathList
$path
4202 if {$path eq
$current_diff_path} {
4203 set after
{reshow_diff
;}
4208 if {$pathList eq
{}} {
4214 [concat
$after {set ui_status_value
{Ready to commit.
}}]
4218 proc do_add_selection
{} {
4219 global current_diff_path selected_paths
4221 if {[array size selected_paths
] > 0} {
4223 {Adding selected files
} \
4224 [array names selected_paths
]
4225 } elseif
{$current_diff_path ne
{}} {
4227 "Adding [short_path $current_diff_path]" \
4228 [list
$current_diff_path]
4232 proc do_add_all
{} {
4236 foreach path
[array names file_states
] {
4237 switch
-glob -- [lindex
$file_states($path) 0] {
4240 ?D
{lappend paths
$path}
4243 add_helper
{Adding all changed files
} $paths
4246 proc revert_helper
{txt paths
} {
4247 global file_states current_diff_path
4249 if {![lock_index begin-update
]} return
4253 foreach path
$paths {
4254 switch
-glob -- [lindex
$file_states($path) 0] {
4258 lappend pathList
$path
4259 if {$path eq
$current_diff_path} {
4260 set after
{reshow_diff
;}
4266 set n
[llength
$pathList]
4270 } elseif
{$n == 1} {
4271 set s
"[short_path [lindex $pathList]]"
4273 set s
"these $n files"
4276 set reply
[tk_dialog \
4278 "[appname] ([reponame])" \
4279 "Revert changes in $s?
4281 Any unadded changes will be permanently lost by the revert." \
4291 [concat
$after {set ui_status_value
{Ready.
}}]
4297 proc do_revert_selection
{} {
4298 global current_diff_path selected_paths
4300 if {[array size selected_paths
] > 0} {
4302 {Reverting selected files
} \
4303 [array names selected_paths
]
4304 } elseif
{$current_diff_path ne
{}} {
4306 "Reverting [short_path $current_diff_path]" \
4307 [list
$current_diff_path]
4311 proc do_signoff
{} {
4314 set me
[committer_ident
]
4315 if {$me eq
{}} return
4317 set sob
"Signed-off-by: $me"
4318 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
4319 if {$last ne
$sob} {
4320 $ui_comm edit separator
4322 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
4323 $ui_comm insert end
"\n"
4325 $ui_comm insert end
"\n$sob"
4326 $ui_comm edit separator
4331 proc do_select_commit_type
{} {
4332 global commit_type selected_commit_type
4334 if {$selected_commit_type eq
{new
}
4335 && [string match amend
* $commit_type]} {
4337 } elseif
{$selected_commit_type eq
{amend
}
4338 && ![string match amend
* $commit_type]} {
4341 # The amend request was rejected...
4343 if {![string match amend
* $commit_type]} {
4344 set selected_commit_type new
4354 global appvers copyright
4355 global tcl_patchLevel tk_patchLevel
4359 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4361 label
$w.header
-text "About [appname]" \
4363 pack
$w.header
-side top
-fill x
4366 button
$w.buttons.close
-text {Close
} \
4368 -command [list destroy
$w]
4369 pack
$w.buttons.close
-side right
4370 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4373 -text "[appname] - a commit creation tool for Git.
4381 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4384 append v
"[appname] version $appvers\n"
4385 append v
"[exec git version]\n"
4387 if {$tcl_patchLevel eq
$tk_patchLevel} {
4388 append v
"Tcl/Tk version $tcl_patchLevel"
4390 append v
"Tcl version $tcl_patchLevel"
4391 append v
", Tk version $tk_patchLevel"
4402 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
4404 menu
$w.ctxm
-tearoff 0
4405 $w.ctxm add
command \
4410 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4413 bind $w <Visibility
> "grab $w; focus $w"
4414 bind $w <Key-Escape
> "destroy $w"
4415 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4416 wm title
$w "About [appname]"
4420 proc do_options
{} {
4421 global repo_config global_config font_descs
4422 global repo_config_new global_config_new
4424 array
unset repo_config_new
4425 array
unset global_config_new
4426 foreach name
[array names repo_config
] {
4427 set repo_config_new
($name) $repo_config($name)
4430 foreach name
[array names repo_config
] {
4432 gui.diffcontext
{continue}
4434 set repo_config_new
($name) $repo_config($name)
4436 foreach name
[array names global_config
] {
4437 set global_config_new
($name) $global_config($name)
4440 set w .options_editor
4442 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4444 label
$w.header
-text "[appname] Options" \
4446 pack
$w.header
-side top
-fill x
4449 button
$w.buttons.restore
-text {Restore Defaults
} \
4451 -command do_restore_defaults
4452 pack
$w.buttons.restore
-side left
4453 button
$w.buttons.save
-text Save \
4455 -command [list do_save_config
$w]
4456 pack
$w.buttons.save
-side right
4457 button
$w.buttons.cancel
-text {Cancel
} \
4459 -command [list destroy
$w]
4460 pack
$w.buttons.cancel
-side right
-padx 5
4461 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4463 labelframe
$w.repo
-text "[reponame] Repository" \
4465 labelframe
$w.global
-text {Global
(All Repositories
)} \
4467 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
4468 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
4472 {t user.name
{User Name
}}
4473 {t user.email
{Email Address
}}
4475 {b merge.summary
{Summarize Merge Commits
}}
4476 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
4478 {b gui.trustmtime
{Trust File Modification Timestamps
}}
4479 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
4480 {t gui.newbranchtemplate
{New Branch Name Template
}}
4482 set type [lindex
$option 0]
4483 set name
[lindex
$option 1]
4484 set text
[lindex
$option 2]
4486 foreach f
{repo global
} {
4487 switch
-glob -- $type {
4489 checkbutton
$w.
$f.
$optid -text $text \
4490 -variable ${f}_config_new
($name) \
4494 pack
$w.
$f.
$optid -side top
-anchor w
4497 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
4499 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4500 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
4501 spinbox
$w.
$f.
$optid.v \
4502 -textvariable ${f}_config_new
($name) \
4506 -width [expr {1 + [string length
$max]}] \
4508 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
4509 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
4510 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4514 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4515 entry
$w.
$f.
$optid.v \
4519 -textvariable ${f}_config_new
($name) \
4521 pack
$w.
$f.
$optid.l
-side left
-anchor w
4522 pack
$w.
$f.
$optid.v
-side left
-anchor w \
4525 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4531 set all_fonts
[lsort
[font families
]]
4532 foreach option
$font_descs {
4533 set name
[lindex
$option 0]
4534 set font
[lindex
$option 1]
4535 set text
[lindex
$option 2]
4537 set global_config_new
(gui.
$font^^family
) \
4538 [font configure
$font -family]
4539 set global_config_new
(gui.
$font^^size
) \
4540 [font configure
$font -size]
4542 frame
$w.global.
$name
4543 label
$w.global.
$name.l
-text "$text:" -font font_ui
4544 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
4545 eval tk_optionMenu
$w.global.
$name.family \
4546 global_config_new
(gui.
$font^^family
) \
4548 spinbox
$w.global.
$name.size \
4549 -textvariable global_config_new
(gui.
$font^^size
) \
4550 -from 2 -to 80 -increment 1 \
4553 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
4554 pack
$w.global.
$name.size
-side right
-anchor e
4555 pack
$w.global.
$name.family
-side right
-anchor e
4556 pack
$w.global.
$name -side top
-anchor w
-fill x
4559 bind $w <Visibility
> "grab $w; focus $w"
4560 bind $w <Key-Escape
> "destroy $w"
4561 wm title
$w "[appname] ([reponame]): Options"
4565 proc do_restore_defaults
{} {
4566 global font_descs default_config repo_config
4567 global repo_config_new global_config_new
4569 foreach name
[array names default_config
] {
4570 set repo_config_new
($name) $default_config($name)
4571 set global_config_new
($name) $default_config($name)
4574 foreach option
$font_descs {
4575 set name
[lindex
$option 0]
4576 set repo_config
(gui.
$name) $default_config(gui.
$name)
4580 foreach option
$font_descs {
4581 set name
[lindex
$option 0]
4582 set font
[lindex
$option 1]
4583 set global_config_new
(gui.
$font^^family
) \
4584 [font configure
$font -family]
4585 set global_config_new
(gui.
$font^^size
) \
4586 [font configure
$font -size]
4590 proc do_save_config
{w
} {
4591 if {[catch
{save_config
} err
]} {
4592 error_popup
"Failed to completely save options:\n\n$err"
4598 proc do_windows_shortcut
{} {
4601 set fn
[tk_getSaveFile \
4603 -title "[appname] ([reponame]): Create Desktop Icon" \
4604 -initialfile "Git [reponame].bat"]
4608 puts
$fd "@ECHO Entering [reponame]"
4609 puts
$fd "@ECHO Starting git-gui... please wait..."
4610 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4611 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
4612 puts
-nonewline $fd "@\"[info nameofexecutable]\""
4613 puts
$fd " \"[file normalize $argv0]\""
4616 error_popup
"Cannot write script:\n\n$err"
4621 proc do_cygwin_shortcut
{} {
4625 set desktop
[exec cygpath \
4633 set fn
[tk_getSaveFile \
4635 -title "[appname] ([reponame]): Create Desktop Icon" \
4636 -initialdir $desktop \
4637 -initialfile "Git [reponame].bat"]
4641 set sh
[exec cygpath \
4645 set me
[exec cygpath \
4649 set gd
[exec cygpath \
4653 set gw
[exec cygpath \
4656 [file dirname [gitdir
]]]
4657 regsub
-all ' $me "'\\''" me
4658 regsub -all ' $gd "'\\''" gd
4659 puts $fd "@ECHO Entering $gw"
4660 puts $fd "@ECHO Starting git-gui... please wait..."
4661 puts -nonewline $fd "@\"$sh\" --login -c \""
4662 puts -nonewline $fd "GIT_DIR='$gd'"
4663 puts -nonewline $fd " '$me'"
4667 error_popup "Cannot write script:\n\n$err"
4672 proc do_macosx_app {} {
4675 set fn [tk_getSaveFile \
4677 -title "[appname] ([reponame]): Create Desktop Icon" \
4678 -initialdir [file join $env(HOME) Desktop] \
4679 -initialfile "Git [reponame].app"]
4682 set Contents [file join $fn Contents]
4683 set MacOS [file join $Contents MacOS]
4684 set exe [file join $MacOS git-gui]
4688 set fd [open [file join $Contents Info.plist] w]
4689 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4690 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4691 <plist version="1.0">
4693 <key>CFBundleDevelopmentRegion</key>
4694 <string>English</string>
4695 <key>CFBundleExecutable</key>
4696 <string>git-gui</string>
4697 <key>CFBundleIdentifier</key>
4698 <string>org.spearce.git-gui</string>
4699 <key>CFBundleInfoDictionaryVersion</key>
4700 <string>6.0</string>
4701 <key>CFBundlePackageType</key>
4702 <string>APPL</string>
4703 <key>CFBundleSignature</key>
4704 <string>????</string>
4705 <key>CFBundleVersion</key>
4706 <string>1.0</string>
4707 <key>NSPrincipalClass</key>
4708 <string>NSApplication</string>
4713 set fd [open $exe w]
4714 set gd [file normalize [gitdir]]
4715 set ep [file normalize [gitexec]]
4716 regsub -all ' $gd "'\\''" gd
4717 regsub
-all ' $ep "'\\''" ep
4718 puts $fd "#!/bin/sh"
4719 foreach name
[array names env
] {
4720 if {[string match GIT_
* $name]} {
4721 regsub
-all ' $env($name) "'\\''" v
4722 puts $fd "export $name='$v'"
4725 puts $fd "export PATH
='$ep':\
$PATH"
4726 puts $fd "export GIT_DIR
='$gd'"
4727 puts $fd "exec [file normalize
$argv0]"
4730 file attributes $exe -permissions u+x,g+x,o+x
4732 error_popup "Cannot
write icon
:\n\n$err"
4737 proc toggle_or_diff {w x y} {
4738 global file_states file_lists current_diff_path ui_index ui_workdir
4739 global last_clicked selected_paths
4741 set pos [split [$w index @$x,$y] .]
4742 set lno [lindex $pos 0]
4743 set col [lindex $pos 1]
4744 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4750 set last_clicked [list $w $lno]
4751 array unset selected_paths
4752 $ui_index tag remove in_sel 0.0 end
4753 $ui_workdir tag remove in_sel 0.0 end
4756 if {$current_diff_path eq $path} {
4757 set after {reshow_diff;}
4761 if {$w eq $ui_index} {
4763 "Unstaging
[short_path
$path] from commit
" \
4765 [concat $after {set ui_status_value {Ready.}}]
4766 } elseif {$w eq $ui_workdir} {
4768 "Adding
[short_path
$path]" \
4770 [concat $after {set ui_status_value {Ready.}}]
4773 show_diff $path $w $lno
4777 proc add_one_to_selection {w x y} {
4778 global file_lists last_clicked selected_paths
4780 set lno [lindex [split [$w index @$x,$y] .] 0]
4781 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4787 if {$last_clicked ne {}
4788 && [lindex $last_clicked 0] ne $w} {
4789 array unset selected_paths
4790 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4793 set last_clicked [list $w $lno]
4794 if {[catch {set in_sel $selected_paths($path)}]} {
4798 unset selected_paths($path)
4799 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4801 set selected_paths($path) 1
4802 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4806 proc add_range_to_selection {w x y} {
4807 global file_lists last_clicked selected_paths
4809 if {[lindex $last_clicked 0] ne $w} {
4810 toggle_or_diff $w $x $y
4814 set lno [lindex [split [$w index @$x,$y] .] 0]
4815 set lc [lindex $last_clicked 1]
4824 foreach path [lrange $file_lists($w) \
4825 [expr {$begin - 1}] \
4826 [expr {$end - 1}]] {
4827 set selected_paths($path) 1
4829 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4832 ######################################################################
4836 set cursor_ptr arrow
4837 font create font_diff -family Courier -size 10
4841 eval font configure font_ui [font actual [.dummy cget -font]]
4845 font create font_uibold
4846 font create font_diffbold
4851 } elseif {[is_MacOSX]} {
4859 proc apply_config {} {
4860 global repo_config font_descs
4862 foreach option $font_descs {
4863 set name [lindex $option 0]
4864 set font [lindex $option 1]
4866 foreach {cn cv} $repo_config(gui.$name) {
4867 font configure $font $cn $cv
4870 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
4872 foreach {cn cv} [font configure $font] {
4873 font configure ${font}bold $cn $cv
4875 font configure ${font}bold -weight bold
4879 set default_config(merge.summary) false
4880 set default_config(merge.verbosity) 2
4881 set default_config(user.name) {}
4882 set default_config(user.email) {}
4884 set default_config(gui.trustmtime) false
4885 set default_config(gui.diffcontext) 5
4886 set default_config(gui.newbranchtemplate) {}
4887 set default_config(gui.fontui) [font configure font_ui]
4888 set default_config(gui.fontdiff) [font configure font_diff]
4890 {fontui font_ui {Main Font}}
4891 {fontdiff font_diff {Diff/Console Font}}
4896 ######################################################################
4902 menu .mbar -tearoff 0
4903 .mbar add cascade -label Repository -menu .mbar.repository
4904 .mbar add cascade -label Edit -menu .mbar.edit
4905 if {!$single_commit} {
4906 .mbar add cascade -label Branch -menu .mbar.branch
4908 .mbar add cascade -label Commit -menu .mbar.commit
4909 if {!$single_commit} {
4910 .mbar add cascade -label Merge -menu .mbar.merge
4911 .mbar add cascade -label Fetch -menu .mbar.fetch
4912 .mbar add cascade -label Push -menu .mbar.push
4914 . configure -menu .mbar
4916 # -- Repository Menu
4918 menu .mbar.repository
4920 .mbar.repository add command \
4921 -label {Browse Current Branch} \
4922 -command {new_browser $current_branch} \
4924 .mbar.repository add separator
4926 .mbar.repository add command \
4927 -label {Visualize Current Branch} \
4928 -command {do_gitk {}} \
4930 .mbar.repository add command \
4931 -label {Visualize All Branches} \
4932 -command {do_gitk {--all}} \
4934 .mbar.repository add separator
4936 if {!$single_commit} {
4937 .mbar.repository add command -label {Database Statistics} \
4941 .mbar.repository add command -label {Compress Database} \
4945 .mbar.repository add command -label {Verify Database} \
4946 -command do_fsck_objects \
4949 .mbar.repository add separator
4952 .mbar.repository add command \
4953 -label {Create Desktop Icon} \
4954 -command do_cygwin_shortcut \
4956 } elseif {[is_Windows]} {
4957 .mbar.repository add command \
4958 -label {Create Desktop Icon} \
4959 -command do_windows_shortcut \
4961 } elseif {[is_MacOSX]} {
4962 .mbar.repository add command \
4963 -label {Create Desktop Icon} \
4964 -command do_macosx_app \
4969 .mbar.repository add command -label Quit \
4971 -accelerator $M1T-Q \
4977 .mbar.edit add command -label Undo \
4978 -command {catch {[focus] edit undo}} \
4979 -accelerator $M1T-Z \
4981 .mbar.edit add command -label Redo \
4982 -command {catch {[focus] edit redo}} \
4983 -accelerator $M1T-Y \
4985 .mbar.edit add separator
4986 .mbar.edit add command -label Cut \
4987 -command {catch {tk_textCut [focus]}} \
4988 -accelerator $M1T-X \
4990 .mbar.edit add command -label Copy \
4991 -command {catch {tk_textCopy [focus]}} \
4992 -accelerator $M1T-C \
4994 .mbar.edit add command -label Paste \
4995 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4996 -accelerator $M1T-V \
4998 .mbar.edit add command -label Delete \
4999 -command {catch {[focus] delete sel.first sel.last}} \
5002 .mbar.edit add separator
5003 .mbar.edit add command -label {Select All} \
5004 -command {catch {[focus] tag add sel 0.0 end}} \
5005 -accelerator $M1T-A \
5010 if {!$single_commit} {
5013 .mbar.branch add command -label {Create...} \
5014 -command do_create_branch \
5015 -accelerator $M1T-N \
5017 lappend disable_on_lock [list .mbar.branch entryconf \
5018 [.mbar.branch index last] -state]
5020 .mbar.branch add command -label {Delete...} \
5021 -command do_delete_branch \
5023 lappend disable_on_lock [list .mbar.branch entryconf \
5024 [.mbar.branch index last] -state]
5031 .mbar.commit add radiobutton \
5032 -label {New Commit} \
5033 -command do_select_commit_type \
5034 -variable selected_commit_type \
5037 lappend disable_on_lock \
5038 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5040 .mbar.commit add radiobutton \
5041 -label {Amend Last Commit} \
5042 -command do_select_commit_type \
5043 -variable selected_commit_type \
5046 lappend disable_on_lock \
5047 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5049 .mbar.commit add separator
5051 .mbar.commit add command -label Rescan \
5052 -command do_rescan \
5055 lappend disable_on_lock \
5056 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5058 .mbar.commit add command -label {Add To Commit} \
5059 -command do_add_selection \
5061 lappend disable_on_lock \
5062 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5064 .mbar.commit add command -label {Add All To Commit} \
5065 -command do_add_all \
5066 -accelerator $M1T-I \
5068 lappend disable_on_lock \
5069 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5071 .mbar.commit add command -label {Unstage From Commit} \
5072 -command do_unstage_selection \
5074 lappend disable_on_lock \
5075 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5077 .mbar.commit add command -label {Revert Changes} \
5078 -command do_revert_selection \
5080 lappend disable_on_lock \
5081 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5083 .mbar.commit add separator
5085 .mbar.commit add command -label {Sign Off} \
5086 -command do_signoff \
5087 -accelerator $M1T-S \
5090 .mbar.commit add command -label Commit \
5091 -command do_commit \
5092 -accelerator $M1T-Return \
5094 lappend disable_on_lock \
5095 [list .mbar.commit entryconf [.mbar.commit index last] -state]
5098 # -- Apple Menu (Mac OS X only)
5100 .mbar add cascade -label Apple -menu .mbar.apple
5103 .mbar.apple add command -label "About
[appname
]" \
5106 .mbar.apple add command -label "[appname
] Options...
" \
5107 -command do_options \
5112 .mbar.edit add separator
5113 .mbar.edit add command -label {Options...} \
5114 -command do_options \
5119 if {[file exists /usr/local/miga/lib/gui-miga]
5120 && [file exists .pvcsrc]} {
5122 global ui_status_value
5123 if {![lock_index update]} return
5124 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
5125 set miga_fd [open "|
$cmd" r]
5126 fconfigure $miga_fd -blocking 0
5127 fileevent $miga_fd readable [list miga_done $miga_fd]
5128 set ui_status_value {Running miga...}
5130 proc miga_done {fd} {
5135 rescan [list set ui_status_value {Ready.}]
5138 .mbar add cascade -label Tools -menu .mbar.tools
5140 .mbar.tools add command -label "Migrate
" \
5143 lappend disable_on_lock \
5144 [list .mbar.tools entryconf [.mbar.tools index last] -state]
5150 .mbar add cascade -label Help -menu .mbar.help
5154 .mbar.help add command -label "About
[appname
]" \
5160 catch {set browser $repo_config(instaweb.browser)}
5161 set doc_path [file dirname [gitexec]]
5162 set doc_path [file join $doc_path Documentation index.html]
5165 set doc_path [exec cygpath --windows $doc_path]
5168 if {$browser eq {}} {
5171 } elseif {[is_Cygwin]} {
5172 set program_files [file dirname [exec cygpath --windir]]
5173 set program_files [file join $program_files {Program Files}]
5174 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
5175 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
5176 if {[file exists $firefox]} {
5177 set browser $firefox
5178 } elseif {[file exists $ie]} {
5181 unset program_files firefox ie
5185 if {[file isfile $doc_path]} {
5186 set doc_url "file:$doc_path"
5188 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
5191 if {$browser ne {}} {
5192 .mbar.help add command -label {Online Documentation} \
5193 -command [list exec $browser $doc_url &] \
5196 unset browser doc_path doc_url
5204 -text {Current Branch:} \
5209 -textvariable current_branch \
5213 pack .branch.l1 -side left
5214 pack .branch.cb -side left -fill x
5215 pack .branch -side top -fill x
5217 if {!$single_commit} {
5219 .mbar.merge add command -label {Local Merge...} \
5220 -command do_local_merge \
5222 lappend disable_on_lock \
5223 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5224 .mbar.merge add command -label {Abort Merge...} \
5225 -command do_reset_hard \
5227 lappend disable_on_lock \
5228 [list .mbar.merge entryconf [.mbar.merge index last] -state]
5234 .mbar.push add command -label {Push...} \
5235 -command do_push_anywhere \
5239 # -- Main Window Layout
5241 panedwindow .vpane -orient vertical
5242 panedwindow .vpane.files -orient horizontal
5243 .vpane add .vpane.files -sticky nsew -height 100 -width 200
5244 pack .vpane -anchor n -side top -fill both -expand 1
5246 # -- Index File List
5248 frame .vpane.files.index -height 100 -width 200
5249 label .vpane.files.index.title -text {Changes To Be Committed} \
5252 text $ui_index -background white -borderwidth 0 \
5253 -width 20 -height 10 \
5256 -cursor $cursor_ptr \
5257 -xscrollcommand {.vpane.files.index.sx set} \
5258 -yscrollcommand {.vpane.files.index.sy set} \
5260 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
5261 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
5262 pack .vpane.files.index.title -side top -fill x
5263 pack .vpane.files.index.sx -side bottom -fill x
5264 pack .vpane.files.index.sy -side right -fill y
5265 pack $ui_index -side left -fill both -expand 1
5266 .vpane.files add .vpane.files.index -sticky nsew
5268 # -- Working Directory File List
5270 frame .vpane.files.workdir -height 100 -width 200
5271 label .vpane.files.workdir.title -text {Changed But Not Updated} \
5274 text $ui_workdir -background white -borderwidth 0 \
5275 -width 20 -height 10 \
5278 -cursor $cursor_ptr \
5279 -xscrollcommand {.vpane.files.workdir.sx set} \
5280 -yscrollcommand {.vpane.files.workdir.sy set} \
5282 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
5283 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
5284 pack .vpane.files.workdir.title -side top -fill x
5285 pack .vpane.files.workdir.sx -side bottom -fill x
5286 pack .vpane.files.workdir.sy -side right -fill y
5287 pack $ui_workdir -side left -fill both -expand 1
5288 .vpane.files add .vpane.files.workdir -sticky nsew
5290 foreach i [list $ui_index $ui_workdir] {
5291 $i tag conf in_diff -font font_uibold
5292 $i tag conf in_sel \
5293 -background [$i cget -foreground] \
5294 -foreground [$i cget -background]
5298 # -- Diff and Commit Area
5300 frame .vpane.lower -height 300 -width 400
5301 frame .vpane.lower.commarea
5302 frame .vpane.lower.diff -relief sunken -borderwidth 1
5303 pack .vpane.lower.commarea -side top -fill x
5304 pack .vpane.lower.diff -side bottom -fill both -expand 1
5305 .vpane add .vpane.lower -sticky nsew
5307 # -- Commit Area Buttons
5309 frame .vpane.lower.commarea.buttons
5310 label .vpane.lower.commarea.buttons.l -text {} \
5314 pack .vpane.lower.commarea.buttons.l -side top -fill x
5315 pack .vpane.lower.commarea.buttons -side left -fill y
5317 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
5318 -command do_rescan \
5320 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
5321 lappend disable_on_lock \
5322 {.vpane.lower.commarea.buttons.rescan conf -state}
5324 button .vpane.lower.commarea.buttons.incall -text {Add All} \
5325 -command do_add_all \
5327 pack .vpane.lower.commarea.buttons.incall -side top -fill x
5328 lappend disable_on_lock \
5329 {.vpane.lower.commarea.buttons.incall conf -state}
5331 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
5332 -command do_signoff \
5334 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
5336 button .vpane.lower.commarea.buttons.commit -text {Commit} \
5337 -command do_commit \
5339 pack .vpane.lower.commarea.buttons.commit -side top -fill x
5340 lappend disable_on_lock \
5341 {.vpane.lower.commarea.buttons.commit conf -state}
5343 # -- Commit Message Buffer
5345 frame .vpane.lower.commarea.buffer
5346 frame .vpane.lower.commarea.buffer.header
5347 set ui_comm .vpane.lower.commarea.buffer.t
5348 set ui_coml .vpane.lower.commarea.buffer.header.l
5349 radiobutton .vpane.lower.commarea.buffer.header.new \
5350 -text {New Commit} \
5351 -command do_select_commit_type \
5352 -variable selected_commit_type \
5355 lappend disable_on_lock \
5356 [list .vpane.lower.commarea.buffer.header.new conf -state]
5357 radiobutton .vpane.lower.commarea.buffer.header.amend \
5358 -text {Amend Last Commit} \
5359 -command do_select_commit_type \
5360 -variable selected_commit_type \
5363 lappend disable_on_lock \
5364 [list .vpane.lower.commarea.buffer.header.amend conf -state]
5369 proc trace_commit_type {varname args} {
5370 global ui_coml commit_type
5371 switch -glob -- $commit_type {
5372 initial {set txt {Initial Commit Message:}}
5373 amend {set txt {Amended Commit Message:}}
5374 amend-initial {set txt {Amended Initial Commit Message:}}
5375 amend-merge {set txt {Amended Merge Commit Message:}}
5376 merge {set txt {Merge Commit Message:}}
5377 * {set txt {Commit Message:}}
5379 $ui_coml conf -text $txt
5381 trace add variable commit_type write trace_commit_type
5382 pack $ui_coml -side left -fill x
5383 pack .vpane.lower.commarea.buffer.header.amend -side right
5384 pack .vpane.lower.commarea.buffer.header.new -side right
5386 text $ui_comm -background white -borderwidth 1 \
5389 -autoseparators true \
5391 -width 75 -height 9 -wrap none \
5393 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
5394 scrollbar .vpane.lower.commarea.buffer.sby \
5395 -command [list $ui_comm yview]
5396 pack .vpane.lower.commarea.buffer.header -side top -fill x
5397 pack .vpane.lower.commarea.buffer.sby -side right -fill y
5398 pack $ui_comm -side left -fill y
5399 pack .vpane.lower.commarea.buffer -side left -fill y
5401 # -- Commit Message Buffer Context Menu
5403 set ctxm .vpane.lower.commarea.buffer.ctxm
5404 menu $ctxm -tearoff 0
5408 -command {tk_textCut $ui_comm}
5412 -command {tk_textCopy $ui_comm}
5416 -command {tk_textPaste $ui_comm}
5420 -command {$ui_comm delete sel.first sel.last}
5423 -label {Select All} \
5425 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
5430 $ui_comm tag add sel 0.0 end
5431 tk_textCopy $ui_comm
5432 $ui_comm tag remove sel 0.0 end
5439 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
5443 set current_diff_path {}
5444 set current_diff_side {}
5445 set diff_actions [list]
5446 proc trace_current_diff_path {varname args} {
5447 global current_diff_path diff_actions file_states
5448 if {$current_diff_path eq {}} {
5454 set p $current_diff_path
5455 set s [mapdesc [lindex $file_states($p) 0] $p]
5457 set p [escape_path $p]
5461 .vpane.lower.diff.header.status configure -text $s
5462 .vpane.lower.diff.header.file configure -text $f
5463 .vpane.lower.diff.header.path configure -text $p
5464 foreach w $diff_actions {
5468 trace add variable current_diff_path write trace_current_diff_path
5470 frame .vpane.lower.diff.header -background orange
5471 label .vpane.lower.diff.header.status \
5472 -background orange \
5473 -width $max_status_desc \
5477 label .vpane.lower.diff.header.file \
5478 -background orange \
5482 label .vpane.lower.diff.header.path \
5483 -background orange \
5487 pack .vpane.lower.diff.header.status -side left
5488 pack .vpane.lower.diff.header.file -side left
5489 pack .vpane.lower.diff.header.path -fill x
5490 set ctxm .vpane.lower.diff.header.ctxm
5491 menu $ctxm -tearoff 0
5500 -- $current_diff_path
5502 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5503 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
5507 frame .vpane.lower.diff.body
5508 set ui_diff .vpane.lower.diff.body.t
5509 text $ui_diff -background white -borderwidth 0 \
5510 -width 80 -height 15 -wrap none \
5512 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
5513 -yscrollcommand {.vpane.lower.diff.body.sby set} \
5515 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
5516 -command [list $ui_diff xview]
5517 scrollbar .vpane.lower.diff.body.sby -orient vertical \
5518 -command [list $ui_diff yview]
5519 pack .vpane.lower.diff.body.sbx -side bottom -fill x
5520 pack .vpane.lower.diff.body.sby -side right -fill y
5521 pack $ui_diff -side left -fill both -expand 1
5522 pack .vpane.lower.diff.header -side top -fill x
5523 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
5525 $ui_diff tag conf d_cr -elide true
5526 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
5527 $ui_diff tag conf d_+ -foreground {#00a000}
5528 $ui_diff tag conf d_- -foreground red
5530 $ui_diff tag conf d_++ -foreground {#00a000}
5531 $ui_diff tag conf d_-- -foreground red
5532 $ui_diff tag conf d_+s \
5533 -foreground {#00a000} \
5534 -background {#e2effa}
5535 $ui_diff tag conf d_-s \
5537 -background {#e2effa}
5538 $ui_diff tag conf d_s+ \
5539 -foreground {#00a000} \
5541 $ui_diff tag conf d_s- \
5545 $ui_diff tag conf d<<<<<<< \
5546 -foreground orange \
5548 $ui_diff tag conf d======= \
5549 -foreground orange \
5551 $ui_diff tag conf d>>>>>>> \
5552 -foreground orange \
5555 $ui_diff tag raise sel
5557 # -- Diff Body Context Menu
5559 set ctxm .vpane.lower.diff.body.ctxm
5560 menu $ctxm -tearoff 0
5564 -command reshow_diff
5565 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5569 -command {tk_textCopy $ui_diff}
5570 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5572 -label {Select All} \
5574 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
5575 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5580 $ui_diff tag add sel 0.0 end
5581 tk_textCopy $ui_diff
5582 $ui_diff tag remove sel 0.0 end
5584 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5587 -label {Apply/Reverse Hunk} \
5589 -command {apply_hunk $cursorX $cursorY}
5590 set ui_diff_applyhunk [$ctxm index last]
5591 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
5594 -label {Decrease Font Size} \
5596 -command {incr_font_size font_diff -1}
5597 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5599 -label {Increase Font Size} \
5601 -command {incr_font_size font_diff 1}
5602 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5605 -label {Show Less Context} \
5607 -command {if {$repo_config(gui.diffcontext) >= 2} {
5608 incr repo_config(gui.diffcontext) -1
5611 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5613 -label {Show More Context} \
5616 incr repo_config(gui.diffcontext)
5619 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
5621 $ctxm add command -label {Options...} \
5624 bind_button3 $ui_diff "
5627 if {\
$ui_index eq \
$current_diff_side} {
5628 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
5630 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
5632 tk_popup
$ctxm %X
%Y
5634 unset ui_diff_applyhunk
5638 set ui_status_value {Initializing...}
5639 label .status -textvariable ui_status_value \
5645 pack .status -anchor w -side bottom -fill x
5650 set gm $repo_config(gui.geometry)
5651 wm geometry . [lindex $gm 0]
5652 .vpane sash place 0 \
5653 [lindex [.vpane sash coord 0] 0] \
5655 .vpane.files sash place 0 \
5657 [lindex [.vpane.files sash coord 0] 1]
5663 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
5664 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
5665 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
5666 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
5667 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
5668 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
5669 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
5670 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
5671 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5672 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5673 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5675 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5676 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5677 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5678 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5679 bind $ui_diff <$M1B-Key-v> {break}
5680 bind $ui_diff <$M1B-Key-V> {break}
5681 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5682 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5683 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5684 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5685 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5686 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5687 bind $ui_diff <Button-1> {focus %W}
5689 if {!$single_commit} {
5690 bind . <$M1B-Key-n> do_create_branch
5691 bind . <$M1B-Key-N> do_create_branch
5694 bind . <Destroy> do_quit
5695 bind all <Key-F5> do_rescan
5696 bind all <$M1B-Key-r> do_rescan
5697 bind all <$M1B-Key-R> do_rescan
5698 bind . <$M1B-Key-s> do_signoff
5699 bind . <$M1B-Key-S> do_signoff
5700 bind . <$M1B-Key-i> do_add_all
5701 bind . <$M1B-Key-I> do_add_all
5702 bind . <$M1B-Key-Return> do_commit
5703 bind all <$M1B-Key-q> do_quit
5704 bind all <$M1B-Key-Q> do_quit
5705 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5706 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5707 foreach i [list $ui_index $ui_workdir] {
5708 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
5709 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
5710 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
5714 set file_lists($ui_index) [list]
5715 set file_lists($ui_workdir) [list]
5719 set MERGE_HEAD [list]
5722 set current_branch {}
5723 set current_diff_path {}
5724 set selected_commit_type new
5726 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
5727 focus -force $ui_comm
5729 # -- Warn the user about environmental problems. Cygwin's Tcl
5730 # does *not* pass its env array onto any processes it spawns.
5731 # This means that git processes get none of our environment.
5736 set msg "Possible environment issues exist.
5738 The following environment variables are probably
5739 going to be ignored by any Git subprocess run
5743 foreach name [array names env] {
5744 switch -regexp -- $name {
5745 {^GIT_INDEX_FILE$} -
5746 {^GIT_OBJECT_DIRECTORY$} -
5747 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5749 {^GIT_EXTERNAL_DIFF$} -
5753 {^GIT_CONFIG_LOCAL$} -
5754 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5755 append msg " - $name\n"
5758 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5759 append msg " - $name\n"
5761 set suggest_user $name
5765 if {$ignored_env > 0} {
5767 This is due to a known issue with the
5768 Tcl binary distributed by Cygwin.
"
5770 if {$suggest_user ne {}} {
5773 A good replacement
for $suggest_user
5774 is placing values
for the user.name and
5775 user.email settings into your personal
5781 unset ignored_env msg suggest_user name
5784 # -- Only initialize complex UI if we are going to stay running.
5786 if {!$single_commit} {
5790 populate_branch_menu
5795 # -- Only suggest a gc run if we are going to stay running.
5797 if {!$single_commit} {
5798 set object_limit 2000
5799 if {[is_Windows]} {set object_limit 200}
5800 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5801 if {$objects_current >= $object_limit} {
5803 "This repository currently has
$objects_current loose objects.
5805 To maintain optimal performance it is strongly
5806 recommended that you
compress the database
5807 when
more than
$object_limit loose objects exist.
5809 Compress the database now?
"] eq yes} {
5813 unset object_limit _junk objects_current
5816 lock_index begin-read