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
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 {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
431 rescan_stage2
{} $after
434 set ui_status_value
{Refreshing
file status...
}
435 set cmd
[list git update-index
]
437 lappend cmd
--unmerged
438 lappend cmd
--ignore-missing
439 lappend cmd
--refresh
440 set fd_rf
[open
"| $cmd" r
]
441 fconfigure
$fd_rf -blocking 0 -translation binary
442 fileevent
$fd_rf readable \
443 [list rescan_stage2
$fd_rf $after]
447 proc rescan_stage2
{fd after
} {
448 global ui_status_value
449 global rescan_active buf_rdi buf_rdf buf_rlo
453 if {![eof
$fd]} return
457 set ls_others
[list | git ls-files
--others -z \
458 --exclude-per-directory=.gitignore
]
459 set info_exclude
[gitdir info exclude
]
460 if {[file readable
$info_exclude]} {
461 lappend ls_others
"--exclude-from=$info_exclude"
469 set ui_status_value
{Scanning
for modified files ...
}
470 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
471 set fd_df
[open
"| git diff-files -z" r
]
472 set fd_lo
[open
$ls_others r
]
474 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
475 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
476 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
477 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
478 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
479 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
482 proc load_message
{file} {
486 if {[file isfile
$f]} {
487 if {[catch
{set fd
[open
$f r
]}]} {
490 set content
[string trim
[read $fd]]
492 regsub
-all -line {[ \r\t]+$
} $content {} content
493 $ui_comm delete
0.0 end
494 $ui_comm insert end
$content
500 proc read_diff_index
{fd after
} {
503 append buf_rdi
[read $fd]
505 set n
[string length
$buf_rdi]
507 set z1
[string first
"\0" $buf_rdi $c]
510 set z2
[string first
"\0" $buf_rdi $z1]
514 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
515 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
517 [encoding convertfrom
$p] \
519 [list
[lindex
$i 0] [lindex
$i 2]] \
525 set buf_rdi
[string range
$buf_rdi $c end
]
530 rescan_done
$fd buf_rdi
$after
533 proc read_diff_files
{fd after
} {
536 append buf_rdf
[read $fd]
538 set n
[string length
$buf_rdf]
540 set z1
[string first
"\0" $buf_rdf $c]
543 set z2
[string first
"\0" $buf_rdf $z1]
547 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
548 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
550 [encoding convertfrom
$p] \
553 [list
[lindex
$i 0] [lindex
$i 2]]
558 set buf_rdf
[string range
$buf_rdf $c end
]
563 rescan_done
$fd buf_rdf
$after
566 proc read_ls_others
{fd after
} {
569 append buf_rlo
[read $fd]
570 set pck
[split $buf_rlo "\0"]
571 set buf_rlo
[lindex
$pck end
]
572 foreach p
[lrange
$pck 0 end-1
] {
573 merge_state
[encoding convertfrom
$p] ?O
575 rescan_done
$fd buf_rlo
$after
578 proc rescan_done
{fd buf after
} {
580 global file_states repo_config
583 if {![eof
$fd]} return
586 if {[incr rescan_active
-1] > 0} return
595 proc prune_selection
{} {
596 global file_states selected_paths
598 foreach path
[array names selected_paths
] {
599 if {[catch
{set still_here
$file_states($path)}]} {
600 unset selected_paths
($path)
605 ######################################################################
610 global ui_diff current_diff_path current_diff_header
611 global ui_index ui_workdir
613 $ui_diff conf
-state normal
614 $ui_diff delete
0.0 end
615 $ui_diff conf
-state disabled
617 set current_diff_path
{}
618 set current_diff_header
{}
620 $ui_index tag remove in_diff
0.0 end
621 $ui_workdir tag remove in_diff
0.0 end
624 proc reshow_diff
{} {
625 global ui_status_value file_states file_lists
626 global current_diff_path current_diff_side
628 set p
$current_diff_path
630 ||
$current_diff_side eq
{}
631 ||
[catch
{set s
$file_states($p)}]
632 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
635 show_diff
$p $current_diff_side
639 proc handle_empty_diff
{} {
640 global current_diff_path file_states file_lists
642 set path
$current_diff_path
643 set s
$file_states($path)
644 if {[lindex
$s 0] ne
{_M
}} return
646 info_popup
"No differences detected.
648 [short_path $path] has no changes.
650 The modification date of this file was updated
651 by another application, but the content within
652 the file was not changed.
654 A rescan will be automatically started to find
655 other files which may have the same state."
658 display_file
$path __
659 rescan
{set ui_status_value
{Ready.
}} 0
662 proc show_diff
{path w
{lno
{}}} {
663 global file_states file_lists
664 global is_3way_diff diff_active repo_config
665 global ui_diff ui_status_value ui_index ui_workdir
666 global current_diff_path current_diff_side current_diff_header
668 if {$diff_active ||
![lock_index
read]} return
672 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
678 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
681 set s
$file_states($path)
685 set current_diff_path
$path
686 set current_diff_side
$w
687 set current_diff_header
{}
688 set ui_status_value
"Loading diff of [escape_path $path]..."
690 # - Git won't give us the diff, there's nothing to compare to!
693 set max_sz
[expr {128 * 1024}]
695 set fd
[open
$path r
]
696 set content
[read $fd $max_sz]
698 set sz
[file size
$path]
702 set ui_status_value
"Unable to display [escape_path $path]"
703 error_popup
"Error loading file:\n\n$err"
706 $ui_diff conf
-state normal
707 if {![catch
{set type [exec file $path]}]} {
708 set n
[string length
$path]
709 if {[string equal
-length $n $path $type]} {
710 set type [string range
$type $n end
]
711 regsub
{^
:?\s
*} $type {} type
713 $ui_diff insert end
"* $type\n" d_@
715 if {[string first
"\0" $content] != -1} {
716 $ui_diff insert end \
717 "* Binary file (not showing content)." \
721 $ui_diff insert end \
722 "* Untracked file is $sz bytes.
723 * Showing only first $max_sz bytes.
726 $ui_diff insert end
$content
728 $ui_diff insert end
"
729 * Untracked file clipped here by [appname].
730 * To see the entire file, use an external editor.
734 $ui_diff conf
-state disabled
737 set ui_status_value
{Ready.
}
742 if {$w eq
$ui_index} {
743 lappend cmd diff-index
745 } elseif
{$w eq
$ui_workdir} {
746 if {[string index
$m 0] eq
{U
}} {
749 lappend cmd diff-files
754 lappend cmd
--no-color
755 if {$repo_config(gui.diffcontext
) > 0} {
756 lappend cmd
"-U$repo_config(gui.diffcontext)"
758 if {$w eq
$ui_index} {
764 if {[catch
{set fd
[open
$cmd r
]} err
]} {
767 set ui_status_value
"Unable to display [escape_path $path]"
768 error_popup
"Error loading diff:\n\n$err"
776 fileevent
$fd readable
[list read_diff
$fd]
779 proc read_diff
{fd
} {
780 global ui_diff ui_status_value diff_active
781 global is_3way_diff current_diff_header
783 $ui_diff conf
-state normal
784 while {[gets
$fd line
] >= 0} {
785 # -- Cleanup uninteresting diff header lines.
787 if { [string match
{diff --git *} $line]
788 ||
[string match
{diff --cc *} $line]
789 ||
[string match
{diff --combined *} $line]
790 ||
[string match
{--- *} $line]
791 ||
[string match
{+++ *} $line]} {
792 append current_diff_header
$line "\n"
795 if {[string match
{index
*} $line]} continue
796 if {$line eq
{deleted
file mode
120000}} {
797 set line
"deleted symlink"
800 # -- Automatically detect if this is a 3 way diff.
802 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
804 if {[string match
{mode
*} $line]
805 ||
[string match
{new
file *} $line]
806 ||
[string match
{deleted
file *} $line]
807 ||
[string match
{Binary files
* and
* differ
} $line]
808 ||
$line eq
{\ No newline
at end of
file}
809 ||
[regexp
{^\
* Unmerged path
} $line]} {
811 } elseif
{$is_3way_diff} {
812 set op
[string range
$line 0 1]
822 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
823 set line
[string replace
$line 0 1 { }]
830 puts
"error: Unhandled 3 way diff marker: {$op}"
835 set op
[string index
$line 0]
841 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
842 set line
[string replace
$line 0 0 { }]
849 puts
"error: Unhandled 2 way diff marker: {$op}"
854 $ui_diff insert end
$line $tags
855 if {[string index
$line end
] eq
"\r"} {
856 $ui_diff tag add d_cr
{end
- 2c
}
858 $ui_diff insert end
"\n" $tags
860 $ui_diff conf
-state disabled
866 set ui_status_value
{Ready.
}
868 if {[$ui_diff index end
] eq
{2.0}} {
874 proc apply_hunk
{x y
} {
875 global current_diff_path current_diff_header current_diff_side
876 global ui_diff ui_index file_states
878 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
879 if {![lock_index apply_hunk
]} return
881 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
882 set mi
[lindex
$file_states($current_diff_path) 0]
883 if {$current_diff_side eq
$ui_index} {
885 lappend apply_cmd
--reverse
886 if {[string index
$mi 0] ne
{M
}} {
892 if {[string index
$mi 1] ne
{M
}} {
898 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
899 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
905 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
911 set p
[open
"| $apply_cmd" w
]
912 fconfigure
$p -translation binary
-encoding binary
913 puts
-nonewline $p $current_diff_header
914 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
916 error_popup
"Failed to $mode selected hunk.\n\n$err"
921 $ui_diff conf
-state normal
922 $ui_diff delete
$s_lno $e_lno
923 $ui_diff conf
-state disabled
925 if {[$ui_diff get
1.0 end
] eq
"\n"} {
931 if {$current_diff_side eq
$ui_index} {
933 } elseif
{[string index
$mi 0] eq
{_
}} {
939 display_file
$current_diff_path $mi
945 ######################################################################
949 proc load_last_commit
{} {
950 global HEAD PARENT MERGE_HEAD commit_type ui_comm
953 if {[llength
$PARENT] == 0} {
954 error_popup
{There is nothing to amend.
956 You are about to create the initial commit.
957 There is no commit before this to amend.
962 repository_state curType curHEAD curMERGE_HEAD
963 if {$curType eq
{merge
}} {
964 error_popup
{Cannot amend
while merging.
966 You are currently
in the middle of a merge that
967 has not been fully completed. You cannot amend
968 the prior commit unless you first abort the
969 current merge activity.
977 set fd
[open
"| git cat-file commit $curHEAD" r
]
978 fconfigure
$fd -encoding binary
-translation lf
979 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
982 while {[gets
$fd line
] > 0} {
983 if {[string match
{parent
*} $line]} {
984 lappend parents
[string range
$line 7 end
]
985 } elseif
{[string match
{encoding
*} $line]} {
986 set enc
[string tolower
[string range
$line 9 end
]]
989 fconfigure
$fd -encoding $enc
990 set msg
[string trim
[read $fd]]
993 error_popup
"Error loading commit data for amend:\n\n$err"
999 set MERGE_HEAD
[list
]
1000 switch
-- [llength
$parents] {
1001 0 {set commit_type amend-initial
}
1002 1 {set commit_type amend
}
1003 default
{set commit_type amend-merge
}
1006 $ui_comm delete
0.0 end
1007 $ui_comm insert end
$msg
1009 $ui_comm edit modified false
1010 rescan
{set ui_status_value
{Ready.
}}
1013 proc create_new_commit
{} {
1014 global commit_type ui_comm
1016 set commit_type normal
1017 $ui_comm delete
0.0 end
1019 $ui_comm edit modified false
1020 rescan
{set ui_status_value
{Ready.
}}
1023 set GIT_COMMITTER_IDENT
{}
1025 proc committer_ident
{} {
1026 global GIT_COMMITTER_IDENT
1028 if {$GIT_COMMITTER_IDENT eq
{}} {
1029 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
1030 error_popup
"Unable to obtain your identity:\n\n$err"
1033 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1034 $me me GIT_COMMITTER_IDENT
]} {
1035 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1040 return $GIT_COMMITTER_IDENT
1043 proc commit_tree
{} {
1044 global HEAD commit_type file_states ui_comm repo_config
1045 global ui_status_value pch_error
1047 if {[committer_ident
] eq
{}} return
1048 if {![lock_index update
]} return
1050 # -- Our in memory state should match the repository.
1052 repository_state curType curHEAD curMERGE_HEAD
1053 if {[string match amend
* $commit_type]
1054 && $curType eq
{normal
}
1055 && $curHEAD eq
$HEAD} {
1056 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1057 info_popup
{Last scanned state does not match repository state.
1059 Another Git program has modified this repository
1060 since the last scan. A rescan must be performed
1061 before another commit can be created.
1063 The rescan will be automatically started now.
1066 rescan
{set ui_status_value
{Ready.
}}
1070 # -- At least one file should differ in the index.
1073 foreach path
[array names file_states
] {
1074 switch
-glob -- [lindex
$file_states($path) 0] {
1078 M?
{set files_ready
1}
1080 error_popup
"Unmerged files cannot be committed.
1082 File [short_path $path] has merge conflicts.
1083 You must resolve them and add the file before committing.
1089 error_popup
"Unknown file state [lindex $s 0] detected.
1091 File [short_path $path] cannot be committed by this program.
1096 if {!$files_ready} {
1097 info_popup
{No changes to commit.
1099 You must add
at least
1 file before you can commit.
1105 # -- A message is required.
1107 set msg
[string trim
[$ui_comm get
1.0 end
]]
1108 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1110 error_popup
{Please supply a commit message.
1112 A good commit message has the following format
:
1114 - First line
: Describe
in one sentance what you did.
1115 - Second line
: Blank
1116 - Remaining lines
: Describe why this change is good.
1122 # -- Run the pre-commit hook.
1124 set pchook
[gitdir hooks pre-commit
]
1126 # On Cygwin [file executable] might lie so we need to ask
1127 # the shell if the hook is executable. Yes that's annoying.
1129 if {[is_Cygwin
] && [file isfile
$pchook]} {
1130 set pchook
[list sh
-c [concat \
1131 "if test -x \"$pchook\";" \
1132 "then exec \"$pchook\" 2>&1;" \
1134 } elseif
{[file executable
$pchook]} {
1135 set pchook
[list
$pchook |
& cat]
1137 commit_writetree
$curHEAD $msg
1141 set ui_status_value
{Calling pre-commit hook...
}
1143 set fd_ph
[open
"| $pchook" r
]
1144 fconfigure
$fd_ph -blocking 0 -translation binary
1145 fileevent
$fd_ph readable \
1146 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1149 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1150 global pch_error ui_status_value
1152 append pch_error
[read $fd_ph]
1153 fconfigure
$fd_ph -blocking 1
1155 if {[catch
{close
$fd_ph}]} {
1156 set ui_status_value
{Commit declined by pre-commit hook.
}
1157 hook_failed_popup pre-commit
$pch_error
1160 commit_writetree
$curHEAD $msg
1165 fconfigure
$fd_ph -blocking 0
1168 proc commit_writetree
{curHEAD msg
} {
1169 global ui_status_value
1171 set ui_status_value
{Committing changes...
}
1172 set fd_wt
[open
"| git write-tree" r
]
1173 fileevent
$fd_wt readable \
1174 [list commit_committree
$fd_wt $curHEAD $msg]
1177 proc commit_committree
{fd_wt curHEAD msg
} {
1178 global HEAD PARENT MERGE_HEAD commit_type
1179 global single_commit all_heads current_branch
1180 global ui_status_value ui_comm selected_commit_type
1181 global file_states selected_paths rescan_active
1185 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1186 error_popup
"write-tree failed:\n\n$err"
1187 set ui_status_value
{Commit failed.
}
1192 # -- Build the message.
1194 set msg_p
[gitdir COMMIT_EDITMSG
]
1195 set msg_wt
[open
$msg_p w
]
1196 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1199 fconfigure
$msg_wt -encoding $enc -translation binary
1200 puts
-nonewline $msg_wt $msg
1203 # -- Create the commit.
1205 set cmd
[list git commit-tree
$tree_id]
1206 set parents
[concat
$PARENT $MERGE_HEAD]
1207 if {[llength
$parents] > 0} {
1208 foreach p
$parents {
1212 # git commit-tree writes to stderr during initial commit.
1213 lappend cmd
2>/dev
/null
1216 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1217 error_popup
"commit-tree failed:\n\n$err"
1218 set ui_status_value
{Commit failed.
}
1223 # -- Update the HEAD ref.
1226 if {$commit_type ne
{normal
}} {
1227 append reflogm
" ($commit_type)"
1229 set i
[string first
"\n" $msg]
1231 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1233 append reflogm
{: } $msg
1235 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1236 if {[catch
{eval exec $cmd} err
]} {
1237 error_popup
"update-ref failed:\n\n$err"
1238 set ui_status_value
{Commit failed.
}
1243 # -- Make sure our current branch exists.
1245 if {$commit_type eq
{initial
}} {
1246 lappend all_heads
$current_branch
1247 set all_heads
[lsort
-unique $all_heads]
1248 populate_branch_menu
1251 # -- Cleanup after ourselves.
1253 catch
{file delete
$msg_p}
1254 catch
{file delete
[gitdir MERGE_HEAD
]}
1255 catch
{file delete
[gitdir MERGE_MSG
]}
1256 catch
{file delete
[gitdir SQUASH_MSG
]}
1257 catch
{file delete
[gitdir GITGUI_MSG
]}
1259 # -- Let rerere do its thing.
1261 if {[file isdirectory
[gitdir rr-cache
]]} {
1262 catch
{exec git rerere
}
1265 # -- Run the post-commit hook.
1267 set pchook
[gitdir hooks post-commit
]
1268 if {[is_Cygwin
] && [file isfile
$pchook]} {
1269 set pchook
[list sh
-c [concat \
1270 "if test -x \"$pchook\";" \
1271 "then exec \"$pchook\";" \
1273 } elseif
{![file executable
$pchook]} {
1276 if {$pchook ne
{}} {
1277 catch
{exec $pchook &}
1280 $ui_comm delete
0.0 end
1282 $ui_comm edit modified false
1284 if {$single_commit} do_quit
1286 # -- Update in memory status
1288 set selected_commit_type new
1289 set commit_type normal
1292 set MERGE_HEAD
[list
]
1294 foreach path
[array names file_states
] {
1295 set s
$file_states($path)
1297 switch
-glob -- $m {
1305 unset file_states
($path)
1306 catch
{unset selected_paths
($path)}
1309 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1315 set file_states
($path) [list \
1316 _
[string index
$m 1] \
1327 set ui_status_value \
1328 "Changes committed as [string range $cmt_id 0 7]."
1331 ######################################################################
1335 proc fetch_from
{remote
} {
1336 set w
[new_console \
1338 "Fetching new changes from $remote"]
1339 set cmd
[list git fetch
]
1341 console_exec
$w $cmd console_done
1344 proc push_to
{remote
} {
1345 set w
[new_console \
1347 "Pushing changes to $remote"]
1348 set cmd
[list git push
]
1351 console_exec
$w $cmd console_done
1354 ######################################################################
1358 proc mapicon
{w state path
} {
1361 if {[catch
{set r
$all_icons($state$w)}]} {
1362 puts
"error: no icon for $w state={$state} $path"
1368 proc mapdesc
{state path
} {
1371 if {[catch
{set r
$all_descs($state)}]} {
1372 puts
"error: no desc for state={$state} $path"
1378 proc escape_path
{path
} {
1379 regsub
-all "\n" $path "\\n" path
1383 proc short_path
{path
} {
1384 return [escape_path
[lindex
[file split $path] end
]]
1388 set null_sha1
[string repeat
0 40]
1390 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1391 global file_states next_icon_id null_sha1
1393 set s0
[string index
$new_state 0]
1394 set s1
[string index
$new_state 1]
1396 if {[catch
{set info
$file_states($path)}]} {
1398 set icon n
[incr next_icon_id
]
1400 set state
[lindex
$info 0]
1401 set icon
[lindex
$info 1]
1402 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1403 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1406 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1407 elseif
{$s0 eq
{_
}} {set s0 _
}
1409 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1410 elseif
{$s1 eq
{_
}} {set s1 _
}
1412 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1413 set head_info
[list
0 $null_sha1]
1414 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1415 && $head_info eq
{}} {
1416 set head_info
$index_info
1419 set file_states
($path) [list
$s0$s1 $icon \
1420 $head_info $index_info \
1425 proc display_file_helper
{w path icon_name old_m new_m
} {
1428 if {$new_m eq
{_
}} {
1429 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1431 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1433 $w conf
-state normal
1434 $w delete
$lno.0 [expr {$lno + 1}].0
1435 $w conf
-state disabled
1437 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1438 lappend file_lists
($w) $path
1439 set file_lists
($w) [lsort
-unique $file_lists($w)]
1440 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1442 $w conf
-state normal
1443 $w image create
$lno.0 \
1444 -align center
-padx 5 -pady 1 \
1446 -image [mapicon
$w $new_m $path]
1447 $w insert
$lno.1 "[escape_path $path]\n"
1448 $w conf
-state disabled
1449 } elseif
{$old_m ne
$new_m} {
1450 $w conf
-state normal
1451 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1452 $w conf
-state disabled
1456 proc display_file
{path state
} {
1457 global file_states selected_paths
1458 global ui_index ui_workdir
1460 set old_m
[merge_state
$path $state]
1461 set s
$file_states($path)
1462 set new_m
[lindex
$s 0]
1463 set icon_name
[lindex
$s 1]
1465 set o
[string index
$old_m 0]
1466 set n
[string index
$new_m 0]
1473 display_file_helper
$ui_index $path $icon_name $o $n
1475 if {[string index
$old_m 0] eq
{U
}} {
1478 set o
[string index
$old_m 1]
1480 if {[string index
$new_m 0] eq
{U
}} {
1483 set n
[string index
$new_m 1]
1485 display_file_helper
$ui_workdir $path $icon_name $o $n
1487 if {$new_m eq
{__
}} {
1488 unset file_states
($path)
1489 catch
{unset selected_paths
($path)}
1493 proc display_all_files_helper
{w path icon_name m
} {
1496 lappend file_lists
($w) $path
1497 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1498 $w image create end \
1499 -align center
-padx 5 -pady 1 \
1501 -image [mapicon
$w $m $path]
1502 $w insert end
"[escape_path $path]\n"
1505 proc display_all_files
{} {
1506 global ui_index ui_workdir
1507 global file_states file_lists
1510 $ui_index conf
-state normal
1511 $ui_workdir conf
-state normal
1513 $ui_index delete
0.0 end
1514 $ui_workdir delete
0.0 end
1517 set file_lists
($ui_index) [list
]
1518 set file_lists
($ui_workdir) [list
]
1520 foreach path
[lsort
[array names file_states
]] {
1521 set s
$file_states($path)
1523 set icon_name
[lindex
$s 1]
1525 set s
[string index
$m 0]
1526 if {$s ne
{U
} && $s ne
{_
}} {
1527 display_all_files_helper
$ui_index $path \
1531 if {[string index
$m 0] eq
{U
}} {
1534 set s
[string index
$m 1]
1537 display_all_files_helper
$ui_workdir $path \
1542 $ui_index conf
-state disabled
1543 $ui_workdir conf
-state disabled
1546 proc update_indexinfo
{msg pathList after
} {
1547 global update_index_cp ui_status_value
1549 if {![lock_index update
]} return
1551 set update_index_cp
0
1552 set pathList
[lsort
$pathList]
1553 set totalCnt
[llength
$pathList]
1554 set batch [expr {int
($totalCnt * .01) + 1}]
1555 if {$batch > 25} {set batch 25}
1557 set ui_status_value
[format \
1558 "$msg... %i/%i files (%.2f%%)" \
1562 set fd
[open
"| git update-index -z --index-info" w
]
1569 fileevent
$fd writable
[list \
1570 write_update_indexinfo \
1580 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1581 global update_index_cp ui_status_value
1582 global file_states current_diff_path
1584 if {$update_index_cp >= $totalCnt} {
1591 for {set i
$batch} \
1592 {$update_index_cp < $totalCnt && $i > 0} \
1594 set path
[lindex
$pathList $update_index_cp]
1595 incr update_index_cp
1597 set s
$file_states($path)
1598 switch
-glob -- [lindex
$s 0] {
1605 set info
[lindex
$s 2]
1606 if {$info eq
{}} continue
1608 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1609 display_file
$path $new
1612 set ui_status_value
[format \
1613 "$msg... %i/%i files (%.2f%%)" \
1616 [expr {100.0 * $update_index_cp / $totalCnt}]]
1619 proc update_index
{msg pathList after
} {
1620 global update_index_cp ui_status_value
1622 if {![lock_index update
]} return
1624 set update_index_cp
0
1625 set pathList
[lsort
$pathList]
1626 set totalCnt
[llength
$pathList]
1627 set batch [expr {int
($totalCnt * .01) + 1}]
1628 if {$batch > 25} {set batch 25}
1630 set ui_status_value
[format \
1631 "$msg... %i/%i files (%.2f%%)" \
1635 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1642 fileevent
$fd writable
[list \
1643 write_update_index \
1653 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1654 global update_index_cp ui_status_value
1655 global file_states current_diff_path
1657 if {$update_index_cp >= $totalCnt} {
1664 for {set i
$batch} \
1665 {$update_index_cp < $totalCnt && $i > 0} \
1667 set path
[lindex
$pathList $update_index_cp]
1668 incr update_index_cp
1670 switch
-glob -- [lindex
$file_states($path) 0] {
1676 if {[file exists
$path]} {
1685 puts
-nonewline $fd "[encoding convertto $path]\0"
1686 display_file
$path $new
1689 set ui_status_value
[format \
1690 "$msg... %i/%i files (%.2f%%)" \
1693 [expr {100.0 * $update_index_cp / $totalCnt}]]
1696 proc checkout_index
{msg pathList after
} {
1697 global update_index_cp ui_status_value
1699 if {![lock_index update
]} return
1701 set update_index_cp
0
1702 set pathList
[lsort
$pathList]
1703 set totalCnt
[llength
$pathList]
1704 set batch [expr {int
($totalCnt * .01) + 1}]
1705 if {$batch > 25} {set batch 25}
1707 set ui_status_value
[format \
1708 "$msg... %i/%i files (%.2f%%)" \
1712 set cmd
[list git checkout-index
]
1718 set fd
[open
"| $cmd " w
]
1725 fileevent
$fd writable
[list \
1726 write_checkout_index \
1736 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1737 global update_index_cp ui_status_value
1738 global file_states current_diff_path
1740 if {$update_index_cp >= $totalCnt} {
1747 for {set i
$batch} \
1748 {$update_index_cp < $totalCnt && $i > 0} \
1750 set path
[lindex
$pathList $update_index_cp]
1751 incr update_index_cp
1752 switch
-glob -- [lindex
$file_states($path) 0] {
1756 puts
-nonewline $fd "[encoding convertto $path]\0"
1757 display_file
$path ?_
1762 set ui_status_value
[format \
1763 "$msg... %i/%i files (%.2f%%)" \
1766 [expr {100.0 * $update_index_cp / $totalCnt}]]
1769 ######################################################################
1771 ## branch management
1773 proc is_tracking_branch
{name
} {
1774 global tracking_branches
1776 if {![catch
{set info
$tracking_branches($name)}]} {
1779 foreach t
[array names tracking_branches
] {
1780 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1787 proc load_all_heads
{} {
1790 set all_heads
[list
]
1791 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1792 while {[gets
$fd line
] > 0} {
1793 if {[is_tracking_branch
$line]} continue
1794 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1795 lappend all_heads
$name
1799 set all_heads
[lsort
$all_heads]
1802 proc populate_branch_menu
{} {
1803 global all_heads disable_on_lock
1806 set last
[$m index last
]
1807 for {set i
0} {$i <= $last} {incr i
} {
1808 if {[$m type $i] eq
{separator
}} {
1811 foreach a
$disable_on_lock {
1812 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1816 set disable_on_lock
$new_dol
1821 if {$all_heads ne
{}} {
1824 foreach b
$all_heads {
1825 $m add radiobutton \
1827 -command [list switch_branch
$b] \
1828 -variable current_branch \
1831 lappend disable_on_lock \
1832 [list
$m entryconf
[$m index last
] -state]
1836 proc all_tracking_branches
{} {
1837 global tracking_branches
1839 set all_trackings
{}
1841 foreach name
[array names tracking_branches
] {
1842 if {[regsub
{/\
*$
} $name {} name
]} {
1845 regsub ^refs
/(heads|remotes
)/ $name {} name
1846 lappend all_trackings
$name
1851 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1852 while {[gets
$fd name
] > 0} {
1853 regsub ^refs
/(heads|remotes
)/ $name {} name
1854 lappend all_trackings
$name
1859 return [lsort
-unique $all_trackings]
1862 proc do_create_branch_action
{w
} {
1863 global all_heads null_sha1 repo_config
1864 global create_branch_checkout create_branch_revtype
1865 global create_branch_head create_branch_trackinghead
1866 global create_branch_name create_branch_revexp
1868 set newbranch
$create_branch_name
1869 if {$newbranch eq
{}
1870 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1874 -title [wm title
$w] \
1876 -message "Please supply a branch name."
1877 focus
$w.desc.name_t
1880 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1884 -title [wm title
$w] \
1886 -message "Branch '$newbranch' already exists."
1887 focus
$w.desc.name_t
1890 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1894 -title [wm title
$w] \
1896 -message "We do not like '$newbranch' as a branch name."
1897 focus
$w.desc.name_t
1902 switch
-- $create_branch_revtype {
1903 head {set rev $create_branch_head}
1904 tracking
{set rev $create_branch_trackinghead}
1905 expression
{set rev $create_branch_revexp}
1907 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1911 -title [wm title
$w] \
1913 -message "Invalid starting revision: $rev"
1916 set cmd
[list git update-ref
]
1918 lappend cmd
"branch: Created from $rev"
1919 lappend cmd
"refs/heads/$newbranch"
1921 lappend cmd
$null_sha1
1922 if {[catch
{eval exec $cmd} err
]} {
1926 -title [wm title
$w] \
1928 -message "Failed to create '$newbranch'.\n\n$err"
1932 lappend all_heads
$newbranch
1933 set all_heads
[lsort
$all_heads]
1934 populate_branch_menu
1936 if {$create_branch_checkout} {
1937 switch_branch
$newbranch
1941 proc radio_selector
{varname value args
} {
1942 upvar
#0 $varname var
1946 trace add variable create_branch_head
write \
1947 [list radio_selector create_branch_revtype
head]
1948 trace add variable create_branch_trackinghead
write \
1949 [list radio_selector create_branch_revtype tracking
]
1951 trace add variable delete_branch_head
write \
1952 [list radio_selector delete_branch_checktype
head]
1953 trace add variable delete_branch_trackinghead
write \
1954 [list radio_selector delete_branch_checktype tracking
]
1956 proc do_create_branch
{} {
1957 global all_heads current_branch repo_config
1958 global create_branch_checkout create_branch_revtype
1959 global create_branch_head create_branch_trackinghead
1960 global create_branch_name create_branch_revexp
1962 set w .branch_editor
1964 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1966 label
$w.header
-text {Create New Branch
} \
1968 pack
$w.header
-side top
-fill x
1971 button
$w.buttons.create
-text Create \
1974 -command [list do_create_branch_action
$w]
1975 pack
$w.buttons.create
-side right
1976 button
$w.buttons.cancel
-text {Cancel
} \
1978 -command [list destroy
$w]
1979 pack
$w.buttons.cancel
-side right
-padx 5
1980 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1982 labelframe
$w.desc \
1983 -text {Branch Description
} \
1985 label
$w.desc.name_l
-text {Name
:} -font font_ui
1986 entry
$w.desc.name_t \
1990 -textvariable create_branch_name \
1994 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
1997 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
1998 grid columnconfigure
$w.desc
1 -weight 1
1999 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2001 labelframe
$w.from \
2002 -text {Starting Revision
} \
2004 radiobutton
$w.from.head_r \
2005 -text {Local Branch
:} \
2007 -variable create_branch_revtype \
2009 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2010 grid
$w.from.head_r
$w.from.head_m
-sticky w
2011 set all_trackings
[all_tracking_branches
]
2012 if {$all_trackings ne
{}} {
2013 set create_branch_trackinghead
[lindex
$all_trackings 0]
2014 radiobutton
$w.from.tracking_r \
2015 -text {Tracking Branch
:} \
2017 -variable create_branch_revtype \
2019 eval tk_optionMenu
$w.from.tracking_m \
2020 create_branch_trackinghead \
2022 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2024 radiobutton
$w.from.exp_r \
2025 -text {Revision Expression
:} \
2027 -variable create_branch_revtype \
2029 entry
$w.from.exp_t \
2033 -textvariable create_branch_revexp \
2037 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2038 if {%d
== 1 && [string length
%S
] > 0} {
2039 set create_branch_revtype expression
2043 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2044 grid columnconfigure
$w.from
1 -weight 1
2045 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2047 labelframe
$w.postActions \
2048 -text {Post Creation Actions
} \
2050 checkbutton
$w.postActions.checkout \
2051 -text {Checkout after creation
} \
2052 -variable create_branch_checkout \
2054 pack
$w.postActions.checkout
-anchor nw
2055 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2057 set create_branch_checkout
1
2058 set create_branch_head
$current_branch
2059 set create_branch_revtype
head
2060 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2061 set create_branch_revexp
{}
2063 bind $w <Visibility
> "
2065 $w.desc.name_t icursor end
2066 focus $w.desc.name_t
2068 bind $w <Key-Escape
> "destroy $w"
2069 bind $w <Key-Return
> "do_create_branch_action $w;break"
2070 wm title
$w "[appname] ([reponame]): Create Branch"
2074 proc do_delete_branch_action
{w
} {
2076 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2079 switch
-- $delete_branch_checktype {
2080 head {set check_rev
$delete_branch_head}
2081 tracking
{set check_rev
$delete_branch_trackinghead}
2082 always
{set check_rev
{:none
}}
2084 if {$check_rev eq
{:none
}} {
2086 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2090 -title [wm title
$w] \
2092 -message "Invalid check revision: $check_rev"
2096 set to_delete
[list
]
2097 set not_merged
[list
]
2098 foreach i
[$w.list.l curselection
] {
2099 set b
[$w.list.l get
$i]
2100 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2101 if {$check_cmt ne
{}} {
2102 if {$b eq
$check_rev} continue
2103 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2105 lappend not_merged
$b
2109 lappend to_delete
[list
$b $o]
2111 if {$not_merged ne
{}} {
2112 set msg
"The following branches are not completely merged into $check_rev:
2114 - [join $not_merged "\n - "]"
2118 -title [wm title
$w] \
2122 if {$to_delete eq
{}} return
2123 if {$delete_branch_checktype eq
{always
}} {
2124 set msg
{Recovering deleted branches is difficult.
2126 Delete the selected branches?
}
2127 if {[tk_messageBox \
2130 -title [wm title
$w] \
2132 -message $msg] ne
yes} {
2138 foreach i
$to_delete {
2141 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2142 append failed
" - $b: $err\n"
2144 set x
[lsearch
-sorted -exact $all_heads $b]
2146 set all_heads
[lreplace
$all_heads $x $x]
2151 if {$failed ne
{}} {
2155 -title [wm title
$w] \
2157 -message "Failed to delete branches:\n$failed"
2160 set all_heads
[lsort
$all_heads]
2161 populate_branch_menu
2165 proc do_delete_branch
{} {
2166 global all_heads tracking_branches current_branch
2167 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2169 set w .branch_editor
2171 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2173 label
$w.header
-text {Delete Local Branch
} \
2175 pack
$w.header
-side top
-fill x
2178 button
$w.buttons.create
-text Delete \
2180 -command [list do_delete_branch_action
$w]
2181 pack
$w.buttons.create
-side right
2182 button
$w.buttons.cancel
-text {Cancel
} \
2184 -command [list destroy
$w]
2185 pack
$w.buttons.cancel
-side right
-padx 5
2186 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2188 labelframe
$w.list \
2189 -text {Local Branches
} \
2194 -selectmode extended \
2195 -yscrollcommand [list
$w.list.sby
set] \
2197 foreach h
$all_heads {
2198 if {$h ne
$current_branch} {
2199 $w.list.l insert end
$h
2202 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2203 pack
$w.list.sby
-side right
-fill y
2204 pack
$w.list.l
-side left
-fill both
-expand 1
2205 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2207 labelframe
$w.validate \
2208 -text {Delete Only If
} \
2210 radiobutton
$w.validate.head_r \
2211 -text {Merged Into Local Branch
:} \
2213 -variable delete_branch_checktype \
2215 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2216 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2217 set all_trackings
[all_tracking_branches
]
2218 if {$all_trackings ne
{}} {
2219 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2220 radiobutton
$w.validate.tracking_r \
2221 -text {Merged Into Tracking Branch
:} \
2223 -variable delete_branch_checktype \
2225 eval tk_optionMenu
$w.validate.tracking_m \
2226 delete_branch_trackinghead \
2228 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2230 radiobutton
$w.validate.always_r \
2231 -text {Always
(Do not perform merge checks
)} \
2233 -variable delete_branch_checktype \
2235 grid
$w.validate.always_r
-columnspan 2 -sticky w
2236 grid columnconfigure
$w.validate
1 -weight 1
2237 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2239 set delete_branch_head
$current_branch
2240 set delete_branch_checktype
head
2242 bind $w <Visibility
> "grab $w; focus $w"
2243 bind $w <Key-Escape
> "destroy $w"
2244 wm title
$w "[appname] ([reponame]): Delete Branch"
2248 proc switch_branch
{new_branch
} {
2249 global HEAD commit_type current_branch repo_config
2251 if {![lock_index switch
]} return
2253 # -- Our in memory state should match the repository.
2255 repository_state curType curHEAD curMERGE_HEAD
2256 if {[string match amend
* $commit_type]
2257 && $curType eq
{normal
}
2258 && $curHEAD eq
$HEAD} {
2259 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2260 info_popup
{Last scanned state does not match repository state.
2262 Another Git program has modified this repository
2263 since the last scan. A rescan must be performed
2264 before the current branch can be changed.
2266 The rescan will be automatically started now.
2269 rescan
{set ui_status_value
{Ready.
}}
2273 # -- Don't do a pointless switch.
2275 if {$current_branch eq
$new_branch} {
2280 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2281 switch_branch_stage2
{} $new_branch
2283 set ui_status_value
{Refreshing
file status...
}
2284 set cmd
[list git update-index
]
2286 lappend cmd
--unmerged
2287 lappend cmd
--ignore-missing
2288 lappend cmd
--refresh
2289 set fd_rf
[open
"| $cmd" r
]
2290 fconfigure
$fd_rf -blocking 0 -translation binary
2291 fileevent
$fd_rf readable \
2292 [list switch_branch_stage2
$fd_rf $new_branch]
2296 proc switch_branch_stage2
{fd_rf new_branch
} {
2297 global ui_status_value HEAD
2301 if {![eof
$fd_rf]} return
2305 set ui_status_value
"Updating working directory to '$new_branch'..."
2306 set cmd
[list git read-tree
]
2309 lappend cmd
--exclude-per-directory=.gitignore
2311 lappend cmd
$new_branch
2312 set fd_rt
[open
"| $cmd" r
]
2313 fconfigure
$fd_rt -blocking 0 -translation binary
2314 fileevent
$fd_rt readable \
2315 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2318 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2319 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2320 global current_branch
2321 global ui_comm ui_status_value
2323 # -- We never get interesting output on stdout; only stderr.
2326 fconfigure
$fd_rt -blocking 1
2327 if {![eof
$fd_rt]} {
2328 fconfigure
$fd_rt -blocking 0
2332 # -- The working directory wasn't in sync with the index and
2333 # we'd have to overwrite something to make the switch. A
2334 # merge is required.
2336 if {[catch
{close
$fd_rt} err
]} {
2337 regsub
{^fatal
: } $err {} err
2338 warn_popup
"File level merge required.
2342 Staying on branch '$current_branch'."
2343 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2348 # -- Update the symbolic ref. Core git doesn't even check for failure
2349 # here, it Just Works(tm). If it doesn't we are in some really ugly
2350 # state that is difficult to recover from within git-gui.
2352 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2353 error_popup
"Failed to set current branch.
2355 This working directory is only partially switched.
2356 We successfully updated your files, but failed to
2357 update an internal Git file.
2359 This should not have occurred. [appname] will now
2367 # -- Update our repository state. If we were previously in amend mode
2368 # we need to toss the current buffer and do a full rescan to update
2369 # our file lists. If we weren't in amend mode our file lists are
2370 # accurate and we can avoid the rescan.
2373 set selected_commit_type new
2374 if {[string match amend
* $commit_type]} {
2375 $ui_comm delete
0.0 end
2377 $ui_comm edit modified false
2378 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2380 repository_state commit_type HEAD MERGE_HEAD
2382 set ui_status_value
"Checked out branch '$current_branch'."
2386 ######################################################################
2388 ## remote management
2390 proc load_all_remotes
{} {
2392 global all_remotes tracking_branches
2394 set all_remotes
[list
]
2395 array
unset tracking_branches
2397 set rm_dir
[gitdir remotes
]
2398 if {[file isdirectory
$rm_dir]} {
2399 set all_remotes
[glob \
2403 -directory $rm_dir *]
2405 foreach name
$all_remotes {
2407 set fd
[open
[file join $rm_dir $name] r
]
2408 while {[gets
$fd line
] >= 0} {
2409 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2410 $line line src dst
]} continue
2411 if {![regexp ^refs
/ $dst]} {
2412 set dst
"refs/heads/$dst"
2414 set tracking_branches
($dst) [list
$name $src]
2421 foreach line
[array names repo_config remote.
*.url
] {
2422 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2423 lappend all_remotes
$name
2425 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2429 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2430 if {![regexp ^refs
/ $dst]} {
2431 set dst
"refs/heads/$dst"
2433 set tracking_branches
($dst) [list
$name $src]
2437 set all_remotes
[lsort
-unique $all_remotes]
2440 proc populate_fetch_menu
{} {
2441 global all_remotes repo_config
2444 foreach r
$all_remotes {
2446 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2447 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2452 set fd
[open
[gitdir remotes
$r] r
]
2453 while {[gets
$fd n
] >= 0} {
2454 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2465 -label "Fetch from $r..." \
2466 -command [list fetch_from
$r] \
2472 proc populate_push_menu
{} {
2473 global all_remotes repo_config
2477 foreach r
$all_remotes {
2479 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2480 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2485 set fd
[open
[gitdir remotes
$r] r
]
2486 while {[gets
$fd n
] >= 0} {
2487 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2501 -label "Push to $r..." \
2502 -command [list push_to
$r] \
2509 proc start_push_anywhere_action
{w
} {
2510 global push_urltype push_remote push_url push_thin push_tags
2513 switch
-- $push_urltype {
2514 remote
{set r_url
$push_remote}
2515 url
{set r_url
$push_url}
2517 if {$r_url eq
{}} return
2519 set cmd
[list git push
]
2529 foreach i
[$w.
source.l curselection
] {
2530 set b
[$w.
source.l get
$i]
2531 lappend cmd
"refs/heads/$b:refs/heads/$b"
2536 } elseif
{$cnt == 1} {
2542 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2543 console_exec
$cons $cmd console_done
2547 trace add variable push_remote
write \
2548 [list radio_selector push_urltype remote
]
2550 proc do_push_anywhere
{} {
2551 global all_heads all_remotes current_branch
2552 global push_urltype push_remote push_url push_thin push_tags
2556 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2558 label
$w.header
-text {Push Branches
} -font font_uibold
2559 pack
$w.header
-side top
-fill x
2562 button
$w.buttons.create
-text Push \
2564 -command [list start_push_anywhere_action
$w]
2565 pack
$w.buttons.create
-side right
2566 button
$w.buttons.cancel
-text {Cancel
} \
2568 -command [list destroy
$w]
2569 pack
$w.buttons.cancel
-side right
-padx 5
2570 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2572 labelframe
$w.
source \
2573 -text {Source Branches
} \
2575 listbox
$w.
source.l \
2578 -selectmode extended \
2579 -yscrollcommand [list
$w.
source.sby
set] \
2581 foreach h
$all_heads {
2582 $w.
source.l insert end
$h
2583 if {$h eq
$current_branch} {
2584 $w.
source.l
select set end
2587 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2588 pack
$w.
source.sby
-side right
-fill y
2589 pack
$w.
source.l
-side left
-fill both
-expand 1
2590 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2592 labelframe
$w.dest \
2593 -text {Destination Repository
} \
2595 if {$all_remotes ne
{}} {
2596 radiobutton
$w.dest.remote_r \
2599 -variable push_urltype \
2601 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2602 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2603 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2604 set push_remote origin
2606 set push_remote
[lindex
$all_remotes 0]
2608 set push_urltype remote
2610 set push_urltype url
2612 radiobutton
$w.dest.url_r \
2613 -text {Arbitrary URL
:} \
2615 -variable push_urltype \
2617 entry
$w.dest.url_t \
2621 -textvariable push_url \
2625 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2626 if {%d
== 1 && [string length
%S
] > 0} {
2627 set push_urltype url
2631 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2632 grid columnconfigure
$w.dest
1 -weight 1
2633 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2635 labelframe
$w.options \
2636 -text {Transfer Options
} \
2638 checkbutton
$w.options.thin \
2639 -text {Use thin pack
(for slow network connections
)} \
2640 -variable push_thin \
2642 grid
$w.options.thin
-columnspan 2 -sticky w
2643 checkbutton
$w.options.tags \
2644 -text {Include tags
} \
2645 -variable push_tags \
2647 grid
$w.options.tags
-columnspan 2 -sticky w
2648 grid columnconfigure
$w.options
1 -weight 1
2649 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2655 bind $w <Visibility
> "grab $w"
2656 bind $w <Key-Escape
> "destroy $w"
2657 wm title
$w "[appname] ([reponame]): Push"
2661 ######################################################################
2666 global HEAD commit_type file_states
2668 if {[string match amend
* $commit_type]} {
2669 info_popup
{Cannot merge
while amending.
2671 You must finish amending this commit before
2672 starting any
type of merge.
2677 if {[committer_ident
] eq
{}} {return 0}
2678 if {![lock_index merge
]} {return 0}
2680 # -- Our in memory state should match the repository.
2682 repository_state curType curHEAD curMERGE_HEAD
2683 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2684 info_popup
{Last scanned state does not match repository state.
2686 Another Git program has modified this repository
2687 since the last scan. A rescan must be performed
2688 before a merge can be performed.
2690 The rescan will be automatically started now.
2693 rescan
{set ui_status_value
{Ready.
}}
2697 foreach path
[array names file_states
] {
2698 switch
-glob -- [lindex
$file_states($path) 0] {
2700 continue; # and pray it works!
2703 error_popup
"You are in the middle of a conflicted merge.
2705 File [short_path $path] has merge conflicts.
2707 You must resolve them, add the file, and commit to
2708 complete the current merge. Only then can you
2709 begin another merge.
2715 error_popup
"You are in the middle of a change.
2717 File [short_path $path] is modified.
2719 You should complete the current commit before
2720 starting a merge. Doing so will help you abort
2721 a failed merge, should the need arise.
2732 proc visualize_local_merge
{w
} {
2734 foreach i
[$w.
source.l curselection
] {
2735 lappend revs
[$w.
source.l get
$i]
2737 if {$revs eq
{}} return
2738 lappend revs
--not HEAD
2742 proc start_local_merge_action
{w
} {
2743 global HEAD ui_status_value current_branch
2745 set cmd
[list git merge
]
2748 foreach i
[$w.
source.l curselection
] {
2749 set b
[$w.
source.l get
$i]
2757 } elseif
{$revcnt == 1} {
2759 } elseif
{$revcnt <= 15} {
2765 -title [wm title
$w] \
2767 -message "Too many branches selected.
2769 You have requested to merge $revcnt branches
2770 in an octopus merge. This exceeds Git's
2771 internal limit of 15 branches per merge.
2773 Please select fewer branches. To merge more
2774 than 15 branches, merge the branches in batches.
2779 set msg
"Merging $current_branch, [join $names {, }]"
2780 set ui_status_value
"$msg..."
2781 set cons
[new_console
"Merge" $msg]
2782 console_exec
$cons $cmd [list finish_merge
$revcnt]
2783 bind $w <Destroy
> {}
2787 proc finish_merge
{revcnt w ok
} {
2790 set msg
{Merge completed successfully.
}
2793 info_popup
"Octopus merge failed.
2795 Your merge of $revcnt branches has failed.
2797 There are file-level conflicts between the
2798 branches which must be resolved manually.
2800 The working directory will now be reset.
2802 You can attempt this merge again
2803 by merging only one branch at a time." $w
2805 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2806 fconfigure
$fd -blocking 0 -translation binary
2807 fileevent
$fd readable
[list reset_hard_wait
$fd]
2808 set ui_status_value
{Aborting... please
wait...
}
2812 set msg
{Merge failed. Conflict resolution is required.
}
2815 rescan
[list
set ui_status_value
$msg]
2818 proc do_local_merge
{} {
2819 global current_branch
2821 if {![can_merge
]} return
2825 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2828 -text "Merge Into $current_branch" \
2830 pack
$w.header
-side top
-fill x
2833 button
$w.buttons.visualize
-text Visualize \
2835 -command [list visualize_local_merge
$w]
2836 pack
$w.buttons.visualize
-side left
2837 button
$w.buttons.create
-text Merge \
2839 -command [list start_local_merge_action
$w]
2840 pack
$w.buttons.create
-side right
2841 button
$w.buttons.cancel
-text {Cancel
} \
2843 -command [list destroy
$w]
2844 pack
$w.buttons.cancel
-side right
-padx 5
2845 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2847 labelframe
$w.
source \
2848 -text {Source Branches
} \
2850 listbox
$w.
source.l \
2853 -selectmode extended \
2854 -yscrollcommand [list
$w.
source.sby
set] \
2856 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2857 pack
$w.
source.sby
-side right
-fill y
2858 pack
$w.
source.l
-side left
-fill both
-expand 1
2859 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2861 set cmd
[list git for-each-ref
]
2862 lappend cmd
{--format=%(objectname
) %(refname
)}
2863 lappend cmd refs
/heads
2864 lappend cmd refs
/remotes
2865 set fr_fd
[open
"| $cmd" r
]
2866 fconfigure
$fr_fd -translation binary
2867 while {[gets
$fr_fd line
] > 0} {
2868 set line
[split $line { }]
2869 set sha1
([lindex
$line 0]) [lindex
$line 1]
2874 set fr_fd
[open
"| git rev-list --all --not HEAD"]
2875 while {[gets
$fr_fd line
] > 0} {
2876 if {[catch
{set ref
$sha1($line)}]} continue
2877 regsub ^refs
/(heads|remotes
)/ $ref {} ref
2878 lappend to_show
$ref
2882 foreach ref
[lsort
-unique $to_show] {
2883 $w.
source.l insert end
$ref
2886 bind $w <Visibility
> "grab $w"
2887 bind $w <Key-Escape
> "unlock_index;destroy $w"
2888 bind $w <Destroy
> unlock_index
2889 wm title
$w "[appname] ([reponame]): Merge"
2893 proc do_reset_hard
{} {
2894 global HEAD commit_type file_states
2896 if {[string match amend
* $commit_type]} {
2897 info_popup
{Cannot abort
while amending.
2899 You must finish amending this commit.
2904 if {![lock_index abort
]} return
2906 if {[string match
*merge
* $commit_type]} {
2912 if {[ask_popup
"Abort $op?
2914 Aborting the current $op will cause
2915 *ALL* uncommitted changes to be lost.
2917 Continue with aborting the current $op?"] eq
{yes}} {
2918 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2919 fconfigure
$fd -blocking 0 -translation binary
2920 fileevent
$fd readable
[list reset_hard_wait
$fd]
2921 set ui_status_value
{Aborting... please
wait...
}
2927 proc reset_hard_wait
{fd
} {
2935 $ui_comm delete
0.0 end
2936 $ui_comm edit modified false
2938 catch
{file delete
[gitdir MERGE_HEAD
]}
2939 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
2940 catch
{file delete
[gitdir SQUASH_MSG
]}
2941 catch
{file delete
[gitdir MERGE_MSG
]}
2942 catch
{file delete
[gitdir GITGUI_MSG
]}
2944 rescan
{set ui_status_value
{Abort completed. Ready.
}}
2948 ######################################################################
2953 #define mask_width 14
2954 #define mask_height 15
2955 static unsigned char mask_bits
[] = {
2956 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2957 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2958 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2961 image create bitmap file_plain
-background white
-foreground black
-data {
2962 #define plain_width 14
2963 #define plain_height 15
2964 static unsigned char plain_bits
[] = {
2965 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2966 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2967 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2968 } -maskdata $filemask
2970 image create bitmap file_mod
-background white
-foreground blue
-data {
2971 #define mod_width 14
2972 #define mod_height 15
2973 static unsigned char mod_bits
[] = {
2974 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2975 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2976 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2977 } -maskdata $filemask
2979 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
2980 #define file_fulltick_width 14
2981 #define file_fulltick_height 15
2982 static unsigned char file_fulltick_bits
[] = {
2983 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2984 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2985 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2986 } -maskdata $filemask
2988 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
2989 #define parttick_width 14
2990 #define parttick_height 15
2991 static unsigned char parttick_bits
[] = {
2992 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2993 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2994 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2995 } -maskdata $filemask
2997 image create bitmap file_question
-background white
-foreground black
-data {
2998 #define file_question_width 14
2999 #define file_question_height 15
3000 static unsigned char file_question_bits
[] = {
3001 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3002 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3003 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3004 } -maskdata $filemask
3006 image create bitmap file_removed
-background white
-foreground red
-data {
3007 #define file_removed_width 14
3008 #define file_removed_height 15
3009 static unsigned char file_removed_bits
[] = {
3010 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3011 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3012 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3013 } -maskdata $filemask
3015 image create bitmap file_merge
-background white
-foreground blue
-data {
3016 #define file_merge_width 14
3017 #define file_merge_height 15
3018 static unsigned char file_merge_bits
[] = {
3019 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3020 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3021 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3022 } -maskdata $filemask
3024 set ui_index .vpane.files.index.list
3025 set ui_workdir .vpane.files.workdir.list
3027 set all_icons
(_
$ui_index) file_plain
3028 set all_icons
(A
$ui_index) file_fulltick
3029 set all_icons
(M
$ui_index) file_fulltick
3030 set all_icons
(D
$ui_index) file_removed
3031 set all_icons
(U
$ui_index) file_merge
3033 set all_icons
(_
$ui_workdir) file_plain
3034 set all_icons
(M
$ui_workdir) file_mod
3035 set all_icons
(D
$ui_workdir) file_question
3036 set all_icons
(U
$ui_workdir) file_merge
3037 set all_icons
(O
$ui_workdir) file_plain
3039 set max_status_desc
0
3043 {_M
"Modified, not staged"}
3044 {M_
"Staged for commit"}
3045 {MM
"Portions staged for commit"}
3046 {MD
"Staged for commit, missing"}
3048 {_O
"Untracked, not staged"}
3049 {A_
"Staged for commit"}
3050 {AM
"Portions staged for commit"}
3051 {AD
"Staged for commit, missing"}
3054 {D_
"Staged for removal"}
3055 {DO
"Staged for removal, still present"}
3057 {U_
"Requires merge resolution"}
3058 {UU
"Requires merge resolution"}
3059 {UM
"Requires merge resolution"}
3060 {UD
"Requires merge resolution"}
3062 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3063 set max_status_desc
[string length
[lindex
$i 1]]
3065 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3069 ######################################################################
3073 proc bind_button3
{w cmd
} {
3074 bind $w <Any-Button-3
> $cmd
3076 bind $w <Control-Button-1
> $cmd
3080 proc incr_font_size
{font
{amt
1}} {
3081 set sz
[font configure
$font -size]
3083 font configure
$font -size $sz
3084 font configure
${font}bold
-size $sz
3087 proc hook_failed_popup
{hook msg
} {
3092 label
$w.m.l1
-text "$hook hook failed:" \
3097 -background white
-borderwidth 1 \
3099 -width 80 -height 10 \
3101 -yscrollcommand [list
$w.m.sby
set]
3103 -text {You must correct the above errors before committing.
} \
3107 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3108 pack
$w.m.l1
-side top
-fill x
3109 pack
$w.m.l2
-side bottom
-fill x
3110 pack
$w.m.sby
-side right
-fill y
3111 pack
$w.m.t
-side left
-fill both
-expand 1
3112 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3114 $w.m.t insert
1.0 $msg
3115 $w.m.t conf
-state disabled
3117 button
$w.ok
-text OK \
3120 -command "destroy $w"
3121 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3123 bind $w <Visibility
> "grab $w; focus $w"
3124 bind $w <Key-Return
> "destroy $w"
3125 wm title
$w "[appname] ([reponame]): error"
3129 set next_console_id
0
3131 proc new_console
{short_title long_title
} {
3132 global next_console_id console_data
3133 set w .console
[incr next_console_id
]
3134 set console_data
($w) [list
$short_title $long_title]
3135 return [console_init
$w]
3138 proc console_init
{w
} {
3139 global console_cr console_data M1B
3141 set console_cr
($w) 1.0
3144 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3149 -background white
-borderwidth 1 \
3151 -width 80 -height 10 \
3154 -yscrollcommand [list
$w.m.sby
set]
3155 label
$w.m.s
-text {Working... please
wait...
} \
3159 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3160 pack
$w.m.l1
-side top
-fill x
3161 pack
$w.m.s
-side bottom
-fill x
3162 pack
$w.m.sby
-side right
-fill y
3163 pack
$w.m.t
-side left
-fill both
-expand 1
3164 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3166 menu
$w.ctxm
-tearoff 0
3167 $w.ctxm add
command -label "Copy" \
3169 -command "tk_textCopy $w.m.t"
3170 $w.ctxm add
command -label "Select All" \
3172 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3173 $w.ctxm add
command -label "Copy All" \
3176 $w.m.t tag add sel 0.0 end
3178 $w.m.t tag remove sel 0.0 end
3181 button
$w.ok
-text {Close
} \
3184 -command "destroy $w"
3185 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3187 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
3188 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
3189 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
3190 bind $w <Visibility
> "focus $w"
3191 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
3195 proc console_exec
{w cmd after
} {
3196 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
3197 # But most users need that so we have to relogin. :-(
3200 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
3203 # -- Tcl won't let us redirect both stdout and stderr to
3204 # the same pipe. So pass it through cat...
3206 set cmd
[concat |
$cmd |
& cat]
3208 set fd_f
[open
$cmd r
]
3209 fconfigure
$fd_f -blocking 0 -translation binary
3210 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
3213 proc console_read
{w fd after
} {
3218 if {![winfo exists
$w]} {console_init
$w}
3219 $w.m.t conf
-state normal
3221 set n
[string length
$buf]
3223 set cr
[string first
"\r" $buf $c]
3224 set lf
[string first
"\n" $buf $c]
3225 if {$cr < 0} {set cr
[expr {$n + 1}]}
3226 if {$lf < 0} {set lf
[expr {$n + 1}]}
3229 $w.m.t insert end
[string range
$buf $c $lf]
3230 set console_cr
($w) [$w.m.t index
{end
-1c}]
3234 $w.m.t delete
$console_cr($w) end
3235 $w.m.t insert end
"\n"
3236 $w.m.t insert end
[string range
$buf $c $cr]
3241 $w.m.t conf
-state disabled
3245 fconfigure
$fd -blocking 1
3247 if {[catch
{close
$fd}]} {
3252 uplevel
#0 $after $w $ok
3255 fconfigure
$fd -blocking 0
3258 proc console_chain
{cmdlist w
{ok
1}} {
3260 if {[llength
$cmdlist] == 0} {
3265 set cmd
[lindex
$cmdlist 0]
3266 set cmdlist
[lrange
$cmdlist 1 end
]
3268 if {[lindex
$cmd 0] eq
{console_exec
}} {
3271 [list console_chain
$cmdlist]
3273 uplevel
#0 $cmd $cmdlist $w $ok
3280 proc console_done
{args
} {
3281 global console_cr console_data
3283 switch
-- [llength
$args] {
3285 set w
[lindex
$args 0]
3286 set ok
[lindex
$args 1]
3289 set w
[lindex
$args 1]
3290 set ok
[lindex
$args 2]
3293 error
"wrong number of args: console_done ?ignored? w ok"
3298 if {[winfo exists
$w]} {
3299 $w.m.s conf
-background green
-text {Success
}
3300 $w.ok conf
-state normal
3303 if {![winfo exists
$w]} {
3306 $w.m.s conf
-background red
-text {Error
: Command Failed
}
3307 $w.ok conf
-state normal
3310 array
unset console_cr
$w
3311 array
unset console_data
$w
3314 ######################################################################
3318 set starting_gitk_msg
{Starting gitk... please
wait...
}
3320 proc do_gitk
{revs
} {
3321 global env ui_status_value starting_gitk_msg
3323 # -- On Windows gitk is severly broken, and right now it seems like
3324 # nobody cares about fixing it. The only known workaround is to
3325 # always delete ~/.gitk before starting the program.
3328 catch
{file delete
[file join $env(HOME
) .gitk
]}
3331 # -- Always start gitk through whatever we were loaded with. This
3332 # lets us bypass using shell process on Windows systems.
3334 set cmd
[info nameofexecutable
]
3335 lappend cmd
[gitexec gitk
]
3341 if {[catch
{eval exec $cmd &} err
]} {
3342 error_popup
"Failed to start gitk:\n\n$err"
3344 set ui_status_value
$starting_gitk_msg
3346 if {$ui_status_value eq
$starting_gitk_msg} {
3347 set ui_status_value
{Ready.
}
3354 set fd
[open
"| git count-objects -v" r
]
3355 while {[gets
$fd line
] > 0} {
3356 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
3357 set stats
($name) $value
3363 foreach p
[glob
-directory [gitdir objects pack
] \
3366 incr packed_sz
[file size
$p]
3368 if {$packed_sz > 0} {
3369 set stats
(size-pack
) [expr {$packed_sz / 1024}]
3374 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3376 label
$w.header
-text {Database Statistics
} \
3378 pack
$w.header
-side top
-fill x
3380 frame
$w.buttons
-border 1
3381 button
$w.buttons.close
-text Close \
3383 -command [list destroy
$w]
3384 button
$w.buttons.gc
-text {Compress Database
} \
3386 -command "destroy $w;do_gc"
3387 pack
$w.buttons.close
-side right
3388 pack
$w.buttons.gc
-side left
3389 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3391 frame
$w.stat
-borderwidth 1 -relief solid
3393 {count
{Number of loose objects
}}
3394 {size
{Disk space used by loose objects
} { KiB
}}
3395 {in-pack
{Number of packed objects
}}
3396 {packs
{Number of packs
}}
3397 {size-pack
{Disk space used by packed objects
} { KiB
}}
3398 {prune-packable
{Packed objects waiting
for pruning
}}
3399 {garbage
{Garbage files
}}
3401 set name
[lindex
$s 0]
3402 set label
[lindex
$s 1]
3403 if {[catch
{set value
$stats($name)}]} continue
3404 if {[llength
$s] > 2} {
3405 set value
"$value[lindex $s 2]"
3408 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
3409 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
3410 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
3412 pack
$w.stat
-pady 10 -padx 10
3414 bind $w <Visibility
> "grab $w; focus $w"
3415 bind $w <Key-Escape
> [list destroy
$w]
3416 bind $w <Key-Return
> [list destroy
$w]
3417 wm title
$w "[appname] ([reponame]): Database Statistics"
3422 set w
[new_console
{gc
} {Compressing the object database
}]
3424 {console_exec
{git pack-refs
--prune}}
3425 {console_exec
{git reflog expire
--all}}
3426 {console_exec
{git repack
-a -d -l}}
3427 {console_exec
{git rerere gc
}}
3431 proc do_fsck_objects
{} {
3432 set w
[new_console
{fsck-objects
} \
3433 {Verifying the object database with fsck-objects
}]
3434 set cmd
[list git fsck-objects
]
3437 lappend cmd
--strict
3438 console_exec
$w $cmd console_done
3444 global ui_comm is_quitting repo_config commit_type
3446 if {$is_quitting} return
3449 # -- Stash our current commit buffer.
3451 set save
[gitdir GITGUI_MSG
]
3452 set msg
[string trim
[$ui_comm get
0.0 end
]]
3453 regsub
-all -line {[ \r\t]+$
} $msg {} msg
3454 if {(![string match amend
* $commit_type]
3455 ||
[$ui_comm edit modified
])
3458 set fd
[open
$save w
]
3459 puts
-nonewline $fd $msg
3463 catch
{file delete
$save}
3466 # -- Stash our current window geometry into this repository.
3468 set cfg_geometry
[list
]
3469 lappend cfg_geometry
[wm geometry .
]
3470 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
3471 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
3472 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
3475 if {$cfg_geometry ne
$rc_geometry} {
3476 catch
{exec git repo-config gui.geometry
$cfg_geometry}
3483 rescan
{set ui_status_value
{Ready.
}}
3486 proc unstage_helper
{txt paths
} {
3487 global file_states current_diff_path
3489 if {![lock_index begin-update
]} return
3493 foreach path
$paths {
3494 switch
-glob -- [lindex
$file_states($path) 0] {
3498 lappend pathList
$path
3499 if {$path eq
$current_diff_path} {
3500 set after
{reshow_diff
;}
3505 if {$pathList eq
{}} {
3511 [concat
$after {set ui_status_value
{Ready.
}}]
3515 proc do_unstage_selection
{} {
3516 global current_diff_path selected_paths
3518 if {[array size selected_paths
] > 0} {
3520 {Unstaging selected files from commit
} \
3521 [array names selected_paths
]
3522 } elseif
{$current_diff_path ne
{}} {
3524 "Unstaging [short_path $current_diff_path] from commit" \
3525 [list
$current_diff_path]
3529 proc add_helper
{txt paths
} {
3530 global file_states current_diff_path
3532 if {![lock_index begin-update
]} return
3536 foreach path
$paths {
3537 switch
-glob -- [lindex
$file_states($path) 0] {
3542 lappend pathList
$path
3543 if {$path eq
$current_diff_path} {
3544 set after
{reshow_diff
;}
3549 if {$pathList eq
{}} {
3555 [concat
$after {set ui_status_value
{Ready to commit.
}}]
3559 proc do_add_selection
{} {
3560 global current_diff_path selected_paths
3562 if {[array size selected_paths
] > 0} {
3564 {Adding selected files
} \
3565 [array names selected_paths
]
3566 } elseif
{$current_diff_path ne
{}} {
3568 "Adding [short_path $current_diff_path]" \
3569 [list
$current_diff_path]
3573 proc do_add_all
{} {
3577 foreach path
[array names file_states
] {
3578 switch
-glob -- [lindex
$file_states($path) 0] {
3581 ?D
{lappend paths
$path}
3584 add_helper
{Adding all changed files
} $paths
3587 proc revert_helper
{txt paths
} {
3588 global file_states current_diff_path
3590 if {![lock_index begin-update
]} return
3594 foreach path
$paths {
3595 switch
-glob -- [lindex
$file_states($path) 0] {
3599 lappend pathList
$path
3600 if {$path eq
$current_diff_path} {
3601 set after
{reshow_diff
;}
3607 set n
[llength
$pathList]
3611 } elseif
{$n == 1} {
3612 set s
"[short_path [lindex $pathList]]"
3614 set s
"these $n files"
3617 set reply
[tk_dialog \
3619 "[appname] ([reponame])" \
3620 "Revert changes in $s?
3622 Any unadded changes will be permanently lost by the revert." \
3632 [concat
$after {set ui_status_value
{Ready.
}}]
3638 proc do_revert_selection
{} {
3639 global current_diff_path selected_paths
3641 if {[array size selected_paths
] > 0} {
3643 {Reverting selected files
} \
3644 [array names selected_paths
]
3645 } elseif
{$current_diff_path ne
{}} {
3647 "Reverting [short_path $current_diff_path]" \
3648 [list
$current_diff_path]
3652 proc do_signoff
{} {
3655 set me
[committer_ident
]
3656 if {$me eq
{}} return
3658 set sob
"Signed-off-by: $me"
3659 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
3660 if {$last ne
$sob} {
3661 $ui_comm edit separator
3663 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
3664 $ui_comm insert end
"\n"
3666 $ui_comm insert end
"\n$sob"
3667 $ui_comm edit separator
3672 proc do_select_commit_type
{} {
3673 global commit_type selected_commit_type
3675 if {$selected_commit_type eq
{new
}
3676 && [string match amend
* $commit_type]} {
3678 } elseif
{$selected_commit_type eq
{amend
}
3679 && ![string match amend
* $commit_type]} {
3682 # The amend request was rejected...
3684 if {![string match amend
* $commit_type]} {
3685 set selected_commit_type new
3695 global appvers copyright
3696 global tcl_patchLevel tk_patchLevel
3700 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3702 label
$w.header
-text "About [appname]" \
3704 pack
$w.header
-side top
-fill x
3707 button
$w.buttons.close
-text {Close
} \
3709 -command [list destroy
$w]
3710 pack
$w.buttons.close
-side right
3711 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3714 -text "[appname] - a commit creation tool for Git.
3722 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
3725 append v
"[appname] version $appvers\n"
3726 append v
"[exec git version]\n"
3728 if {$tcl_patchLevel eq
$tk_patchLevel} {
3729 append v
"Tcl/Tk version $tcl_patchLevel"
3731 append v
"Tcl version $tcl_patchLevel"
3732 append v
", Tk version $tk_patchLevel"
3743 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
3745 menu
$w.ctxm
-tearoff 0
3746 $w.ctxm add
command \
3751 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3754 bind $w <Visibility
> "grab $w; focus $w"
3755 bind $w <Key-Escape
> "destroy $w"
3756 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3757 wm title
$w "About [appname]"
3761 proc do_options
{} {
3762 global repo_config global_config font_descs
3763 global repo_config_new global_config_new
3765 array
unset repo_config_new
3766 array
unset global_config_new
3767 foreach name
[array names repo_config
] {
3768 set repo_config_new
($name) $repo_config($name)
3771 foreach name
[array names repo_config
] {
3773 gui.diffcontext
{continue}
3775 set repo_config_new
($name) $repo_config($name)
3777 foreach name
[array names global_config
] {
3778 set global_config_new
($name) $global_config($name)
3781 set w .options_editor
3783 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3785 label
$w.header
-text "[appname] Options" \
3787 pack
$w.header
-side top
-fill x
3790 button
$w.buttons.restore
-text {Restore Defaults
} \
3792 -command do_restore_defaults
3793 pack
$w.buttons.restore
-side left
3794 button
$w.buttons.save
-text Save \
3796 -command [list do_save_config
$w]
3797 pack
$w.buttons.save
-side right
3798 button
$w.buttons.cancel
-text {Cancel
} \
3800 -command [list destroy
$w]
3801 pack
$w.buttons.cancel
-side right
-padx 5
3802 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3804 labelframe
$w.repo
-text "[reponame] Repository" \
3806 labelframe
$w.global
-text {Global
(All Repositories
)} \
3808 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
3809 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
3813 {b merge.summary
{Summarize Merge Commits
}}
3814 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
3816 {b gui.trustmtime
{Trust File Modification Timestamps
}}
3817 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
3818 {t gui.newbranchtemplate
{New Branch Name Template
}}
3820 set type [lindex
$option 0]
3821 set name
[lindex
$option 1]
3822 set text
[lindex
$option 2]
3824 foreach f
{repo global
} {
3825 switch
-glob -- $type {
3827 checkbutton
$w.
$f.
$optid -text $text \
3828 -variable ${f}_config_new
($name) \
3832 pack
$w.
$f.
$optid -side top
-anchor w
3835 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
3837 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
3838 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
3839 spinbox
$w.
$f.
$optid.v \
3840 -textvariable ${f}_config_new
($name) \
3844 -width [expr {1 + [string length
$max]}] \
3846 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
3847 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
3848 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
3852 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
3853 entry
$w.
$f.
$optid.v \
3857 -textvariable ${f}_config_new
($name) \
3859 pack
$w.
$f.
$optid.l
-side left
-anchor w
3860 pack
$w.
$f.
$optid.v
-side left
-anchor w \
3863 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
3869 set all_fonts
[lsort
[font families
]]
3870 foreach option
$font_descs {
3871 set name
[lindex
$option 0]
3872 set font
[lindex
$option 1]
3873 set text
[lindex
$option 2]
3875 set global_config_new
(gui.
$font^^family
) \
3876 [font configure
$font -family]
3877 set global_config_new
(gui.
$font^^size
) \
3878 [font configure
$font -size]
3880 frame
$w.global.
$name
3881 label
$w.global.
$name.l
-text "$text:" -font font_ui
3882 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
3883 eval tk_optionMenu
$w.global.
$name.family \
3884 global_config_new
(gui.
$font^^family
) \
3886 spinbox
$w.global.
$name.size \
3887 -textvariable global_config_new
(gui.
$font^^size
) \
3888 -from 2 -to 80 -increment 1 \
3891 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
3892 pack
$w.global.
$name.size
-side right
-anchor e
3893 pack
$w.global.
$name.family
-side right
-anchor e
3894 pack
$w.global.
$name -side top
-anchor w
-fill x
3897 bind $w <Visibility
> "grab $w; focus $w"
3898 bind $w <Key-Escape
> "destroy $w"
3899 wm title
$w "[appname] ([reponame]): Options"
3903 proc do_restore_defaults
{} {
3904 global font_descs default_config repo_config
3905 global repo_config_new global_config_new
3907 foreach name
[array names default_config
] {
3908 set repo_config_new
($name) $default_config($name)
3909 set global_config_new
($name) $default_config($name)
3912 foreach option
$font_descs {
3913 set name
[lindex
$option 0]
3914 set repo_config
(gui.
$name) $default_config(gui.
$name)
3918 foreach option
$font_descs {
3919 set name
[lindex
$option 0]
3920 set font
[lindex
$option 1]
3921 set global_config_new
(gui.
$font^^family
) \
3922 [font configure
$font -family]
3923 set global_config_new
(gui.
$font^^size
) \
3924 [font configure
$font -size]
3928 proc do_save_config
{w
} {
3929 if {[catch
{save_config
} err
]} {
3930 error_popup
"Failed to completely save options:\n\n$err"
3936 proc do_windows_shortcut
{} {
3939 set fn
[tk_getSaveFile \
3941 -title "[appname] ([reponame]): Create Desktop Icon" \
3942 -initialfile "Git [reponame].bat"]
3946 puts
$fd "@ECHO Entering [reponame]"
3947 puts
$fd "@ECHO Starting git-gui... please wait..."
3948 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
3949 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
3950 puts
-nonewline $fd "@\"[info nameofexecutable]\""
3951 puts
$fd " \"[file normalize $argv0]\""
3954 error_popup
"Cannot write script:\n\n$err"
3959 proc do_cygwin_shortcut
{} {
3963 set desktop
[exec cygpath \
3971 set fn
[tk_getSaveFile \
3973 -title "[appname] ([reponame]): Create Desktop Icon" \
3974 -initialdir $desktop \
3975 -initialfile "Git [reponame].bat"]
3979 set sh
[exec cygpath \
3983 set me
[exec cygpath \
3987 set gd
[exec cygpath \
3991 set gw
[exec cygpath \
3994 [file dirname [gitdir
]]]
3995 regsub
-all ' $me "'\\''" me
3996 regsub -all ' $gd "'\\''" gd
3997 puts $fd "@ECHO Entering $gw"
3998 puts $fd "@ECHO Starting git-gui... please wait..."
3999 puts -nonewline $fd "@\"$sh\" --login -c \""
4000 puts -nonewline $fd "GIT_DIR='$gd'"
4001 puts -nonewline $fd " '$me'"
4005 error_popup "Cannot write script:\n\n$err"
4010 proc do_macosx_app {} {
4013 set fn [tk_getSaveFile \
4015 -title "[appname] ([reponame]): Create Desktop Icon" \
4016 -initialdir [file join $env(HOME) Desktop] \
4017 -initialfile "Git [reponame].app"]
4020 set Contents [file join $fn Contents]
4021 set MacOS [file join $Contents MacOS]
4022 set exe [file join $MacOS git-gui]
4026 set fd [open [file join $Contents Info.plist] w]
4027 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4028 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4029 <plist version="1.0">
4031 <key>CFBundleDevelopmentRegion</key>
4032 <string>English</string>
4033 <key>CFBundleExecutable</key>
4034 <string>git-gui</string>
4035 <key>CFBundleIdentifier</key>
4036 <string>org.spearce.git-gui</string>
4037 <key>CFBundleInfoDictionaryVersion</key>
4038 <string>6.0</string>
4039 <key>CFBundlePackageType</key>
4040 <string>APPL</string>
4041 <key>CFBundleSignature</key>
4042 <string>????</string>
4043 <key>CFBundleVersion</key>
4044 <string>1.0</string>
4045 <key>NSPrincipalClass</key>
4046 <string>NSApplication</string>
4051 set fd [open $exe w]
4052 set gd [file normalize [gitdir]]
4053 set ep [file normalize [gitexec]]
4054 regsub -all ' $gd "'\\''" gd
4055 regsub
-all ' $ep "'\\''" ep
4056 puts $fd "#!/bin/sh"
4057 foreach name
[array names env
] {
4058 if {[string match GIT_
* $name]} {
4059 regsub
-all ' $env($name) "'\\''" v
4060 puts $fd "export $name='$v'"
4063 puts $fd "export PATH
='$ep':\
$PATH"
4064 puts $fd "export GIT_DIR
='$gd'"
4065 puts $fd "exec [file normalize
$argv0]"
4068 file attributes $exe -permissions u+x,g+x,o+x
4070 error_popup "Cannot
write icon
:\n\n$err"
4075 proc toggle_or_diff {w x y} {
4076 global file_states file_lists current_diff_path ui_index ui_workdir
4077 global last_clicked selected_paths
4079 set pos [split [$w index @$x,$y] .]
4080 set lno [lindex $pos 0]
4081 set col [lindex $pos 1]
4082 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4088 set last_clicked [list $w $lno]
4089 array unset selected_paths
4090 $ui_index tag remove in_sel 0.0 end
4091 $ui_workdir tag remove in_sel 0.0 end
4094 if {$current_diff_path eq $path} {
4095 set after {reshow_diff;}
4099 if {$w eq $ui_index} {
4101 "Unstaging
[short_path
$path] from commit
" \
4103 [concat $after {set ui_status_value {Ready.}}]
4104 } elseif {$w eq $ui_workdir} {
4106 "Adding
[short_path
$path]" \
4108 [concat $after {set ui_status_value {Ready.}}]
4111 show_diff $path $w $lno
4115 proc add_one_to_selection {w x y} {
4116 global file_lists last_clicked selected_paths
4118 set lno [lindex [split [$w index @$x,$y] .] 0]
4119 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4125 if {$last_clicked ne {}
4126 && [lindex $last_clicked 0] ne $w} {
4127 array unset selected_paths
4128 [lindex $last_clicked 0] tag remove in_sel 0.0 end
4131 set last_clicked [list $w $lno]
4132 if {[catch {set in_sel $selected_paths($path)}]} {
4136 unset selected_paths($path)
4137 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
4139 set selected_paths($path) 1
4140 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
4144 proc add_range_to_selection {w x y} {
4145 global file_lists last_clicked selected_paths
4147 if {[lindex $last_clicked 0] ne $w} {
4148 toggle_or_diff $w $x $y
4152 set lno [lindex [split [$w index @$x,$y] .] 0]
4153 set lc [lindex $last_clicked 1]
4162 foreach path [lrange $file_lists($w) \
4163 [expr {$begin - 1}] \
4164 [expr {$end - 1}]] {
4165 set selected_paths($path) 1
4167 $w tag add in_sel $begin.0 [expr {$end + 1}].0
4170 ######################################################################
4174 set cursor_ptr arrow
4175 font create font_diff -family Courier -size 10
4179 eval font configure font_ui [font actual [.dummy cget -font]]
4183 font create font_uibold
4184 font create font_diffbold
4189 } elseif {[is_MacOSX]} {
4197 proc apply_config {} {
4198 global repo_config font_descs
4200 foreach option $font_descs {
4201 set name [lindex $option 0]
4202 set font [lindex $option 1]
4204 foreach {cn cv} $repo_config(gui.$name) {
4205 font configure $font $cn $cv
4208 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
4210 foreach {cn cv} [font configure $font] {
4211 font configure ${font}bold $cn $cv
4213 font configure ${font}bold -weight bold
4217 set default_config(merge.summary) false
4218 set default_config(merge.verbosity) 2
4219 set default_config(gui.trustmtime) false
4220 set default_config(gui.diffcontext) 5
4221 set default_config(gui.newbranchtemplate) {}
4222 set default_config(gui.fontui) [font configure font_ui]
4223 set default_config(gui.fontdiff) [font configure font_diff]
4225 {fontui font_ui {Main Font}}
4226 {fontdiff font_diff {Diff/Console Font}}
4231 ######################################################################
4237 menu .mbar -tearoff 0
4238 .mbar add cascade -label Repository -menu .mbar.repository
4239 .mbar add cascade -label Edit -menu .mbar.edit
4240 if {!$single_commit} {
4241 .mbar add cascade -label Branch -menu .mbar.branch
4243 .mbar add cascade -label Commit -menu .mbar.commit
4244 if {!$single_commit} {
4245 .mbar add cascade -label Merge -menu .mbar.merge
4246 .mbar add cascade -label Fetch -menu .mbar.fetch
4247 .mbar add cascade -label Push -menu .mbar.push
4249 . configure -menu .mbar
4251 # -- Repository Menu
4253 menu .mbar.repository
4254 .mbar.repository add command \
4255 -label {Visualize Current Branch} \
4256 -command {do_gitk {}} \
4258 .mbar.repository add command \
4259 -label {Visualize All Branches} \
4260 -command {do_gitk {--all}} \
4262 .mbar.repository add separator
4264 if {!$single_commit} {
4265 .mbar.repository add command -label {Database Statistics} \
4269 .mbar.repository add command -label {Compress Database} \
4273 .mbar.repository add command -label {Verify Database} \
4274 -command do_fsck_objects \
4277 .mbar.repository add separator
4280 .mbar.repository add command \
4281 -label {Create Desktop Icon} \
4282 -command do_cygwin_shortcut \
4284 } elseif {[is_Windows]} {
4285 .mbar.repository add command \
4286 -label {Create Desktop Icon} \
4287 -command do_windows_shortcut \
4289 } elseif {[is_MacOSX]} {
4290 .mbar.repository add command \
4291 -label {Create Desktop Icon} \
4292 -command do_macosx_app \
4297 .mbar.repository add command -label Quit \
4299 -accelerator $M1T-Q \
4305 .mbar.edit add command -label Undo \
4306 -command {catch {[focus] edit undo}} \
4307 -accelerator $M1T-Z \
4309 .mbar.edit add command -label Redo \
4310 -command {catch {[focus] edit redo}} \
4311 -accelerator $M1T-Y \
4313 .mbar.edit add separator
4314 .mbar.edit add command -label Cut \
4315 -command {catch {tk_textCut [focus]}} \
4316 -accelerator $M1T-X \
4318 .mbar.edit add command -label Copy \
4319 -command {catch {tk_textCopy [focus]}} \
4320 -accelerator $M1T-C \
4322 .mbar.edit add command -label Paste \
4323 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
4324 -accelerator $M1T-V \
4326 .mbar.edit add command -label Delete \
4327 -command {catch {[focus] delete sel.first sel.last}} \
4330 .mbar.edit add separator
4331 .mbar.edit add command -label {Select All} \
4332 -command {catch {[focus] tag add sel 0.0 end}} \
4333 -accelerator $M1T-A \
4338 if {!$single_commit} {
4341 .mbar.branch add command -label {Create...} \
4342 -command do_create_branch \
4343 -accelerator $M1T-N \
4345 lappend disable_on_lock [list .mbar.branch entryconf \
4346 [.mbar.branch index last] -state]
4348 .mbar.branch add command -label {Delete...} \
4349 -command do_delete_branch \
4351 lappend disable_on_lock [list .mbar.branch entryconf \
4352 [.mbar.branch index last] -state]
4359 .mbar.commit add radiobutton \
4360 -label {New Commit} \
4361 -command do_select_commit_type \
4362 -variable selected_commit_type \
4365 lappend disable_on_lock \
4366 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4368 .mbar.commit add radiobutton \
4369 -label {Amend Last Commit} \
4370 -command do_select_commit_type \
4371 -variable selected_commit_type \
4374 lappend disable_on_lock \
4375 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4377 .mbar.commit add separator
4379 .mbar.commit add command -label Rescan \
4380 -command do_rescan \
4383 lappend disable_on_lock \
4384 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4386 .mbar.commit add command -label {Add To Commit} \
4387 -command do_add_selection \
4389 lappend disable_on_lock \
4390 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4392 .mbar.commit add command -label {Add All To Commit} \
4393 -command do_add_all \
4394 -accelerator $M1T-I \
4396 lappend disable_on_lock \
4397 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4399 .mbar.commit add command -label {Unstage From Commit} \
4400 -command do_unstage_selection \
4402 lappend disable_on_lock \
4403 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4405 .mbar.commit add command -label {Revert Changes} \
4406 -command do_revert_selection \
4408 lappend disable_on_lock \
4409 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4411 .mbar.commit add separator
4413 .mbar.commit add command -label {Sign Off} \
4414 -command do_signoff \
4415 -accelerator $M1T-S \
4418 .mbar.commit add command -label Commit \
4419 -command do_commit \
4420 -accelerator $M1T-Return \
4422 lappend disable_on_lock \
4423 [list .mbar.commit entryconf [.mbar.commit index last] -state]
4426 # -- Apple Menu (Mac OS X only)
4428 .mbar add cascade -label Apple -menu .mbar.apple
4431 .mbar.apple add command -label "About
[appname
]" \
4434 .mbar.apple add command -label "[appname
] Options...
" \
4435 -command do_options \
4440 .mbar.edit add separator
4441 .mbar.edit add command -label {Options...} \
4442 -command do_options \
4447 if {[file exists /usr/local/miga/lib/gui-miga]
4448 && [file exists .pvcsrc]} {
4450 global ui_status_value
4451 if {![lock_index update]} return
4452 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
4453 set miga_fd [open "|
$cmd" r]
4454 fconfigure $miga_fd -blocking 0
4455 fileevent $miga_fd readable [list miga_done $miga_fd]
4456 set ui_status_value {Running miga...}
4458 proc miga_done {fd} {
4463 rescan [list set ui_status_value {Ready.}]
4466 .mbar add cascade -label Tools -menu .mbar.tools
4468 .mbar.tools add command -label "Migrate
" \
4471 lappend disable_on_lock \
4472 [list .mbar.tools entryconf [.mbar.tools index last] -state]
4478 .mbar add cascade -label Help -menu .mbar.help
4482 .mbar.help add command -label "About
[appname
]" \
4488 catch {set browser $repo_config(instaweb.browser)}
4489 set doc_path [file dirname [gitexec]]
4490 set doc_path [file join $doc_path Documentation index.html]
4493 set doc_path [exec cygpath --windows $doc_path]
4496 if {$browser eq {}} {
4499 } elseif {[is_Cygwin]} {
4500 set program_files [file dirname [exec cygpath --windir]]
4501 set program_files [file join $program_files {Program Files}]
4502 set firefox [file join $program_files {Mozilla Firefox} firefox.exe]
4503 set ie [file join $program_files {Internet Explorer} IEXPLORE.EXE]
4504 if {[file exists $firefox]} {
4505 set browser $firefox
4506 } elseif {[file exists $ie]} {
4509 unset program_files firefox ie
4513 if {[file isfile $doc_path]} {
4514 set doc_url "file:$doc_path"
4516 set doc_url {http://www.kernel.org/pub/software/scm/git/docs/}
4519 if {$browser ne {}} {
4520 .mbar.help add command -label {Online Documentation} \
4521 -command [list exec $browser $doc_url &] \
4524 unset browser doc_path doc_url
4532 -text {Current Branch:} \
4537 -textvariable current_branch \
4541 pack .branch.l1 -side left
4542 pack .branch.cb -side left -fill x
4543 pack .branch -side top -fill x
4545 if {!$single_commit} {
4547 .mbar.merge add command -label {Local Merge...} \
4548 -command do_local_merge \
4550 lappend disable_on_lock \
4551 [list .mbar.merge entryconf [.mbar.merge index last] -state]
4552 .mbar.merge add command -label {Abort Merge...} \
4553 -command do_reset_hard \
4555 lappend disable_on_lock \
4556 [list .mbar.merge entryconf [.mbar.merge index last] -state]
4562 .mbar.push add command -label {Push...} \
4563 -command do_push_anywhere \
4567 # -- Main Window Layout
4569 panedwindow .vpane -orient vertical
4570 panedwindow .vpane.files -orient horizontal
4571 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4572 pack .vpane -anchor n -side top -fill both -expand 1
4574 # -- Index File List
4576 frame .vpane.files.index -height 100 -width 200
4577 label .vpane.files.index.title -text {Changes To Be Committed} \
4580 text $ui_index -background white -borderwidth 0 \
4581 -width 20 -height 10 \
4584 -cursor $cursor_ptr \
4585 -xscrollcommand {.vpane.files.index.sx set} \
4586 -yscrollcommand {.vpane.files.index.sy set} \
4588 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4589 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4590 pack .vpane.files.index.title -side top -fill x
4591 pack .vpane.files.index.sx -side bottom -fill x
4592 pack .vpane.files.index.sy -side right -fill y
4593 pack $ui_index -side left -fill both -expand 1
4594 .vpane.files add .vpane.files.index -sticky nsew
4596 # -- Working Directory File List
4598 frame .vpane.files.workdir -height 100 -width 200
4599 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4602 text $ui_workdir -background white -borderwidth 0 \
4603 -width 20 -height 10 \
4606 -cursor $cursor_ptr \
4607 -xscrollcommand {.vpane.files.workdir.sx set} \
4608 -yscrollcommand {.vpane.files.workdir.sy set} \
4610 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4611 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4612 pack .vpane.files.workdir.title -side top -fill x
4613 pack .vpane.files.workdir.sx -side bottom -fill x
4614 pack .vpane.files.workdir.sy -side right -fill y
4615 pack $ui_workdir -side left -fill both -expand 1
4616 .vpane.files add .vpane.files.workdir -sticky nsew
4618 foreach i [list $ui_index $ui_workdir] {
4619 $i tag conf in_diff -font font_uibold
4620 $i tag conf in_sel \
4621 -background [$i cget -foreground] \
4622 -foreground [$i cget -background]
4626 # -- Diff and Commit Area
4628 frame .vpane.lower -height 300 -width 400
4629 frame .vpane.lower.commarea
4630 frame .vpane.lower.diff -relief sunken -borderwidth 1
4631 pack .vpane.lower.commarea -side top -fill x
4632 pack .vpane.lower.diff -side bottom -fill both -expand 1
4633 .vpane add .vpane.lower -sticky nsew
4635 # -- Commit Area Buttons
4637 frame .vpane.lower.commarea.buttons
4638 label .vpane.lower.commarea.buttons.l -text {} \
4642 pack .vpane.lower.commarea.buttons.l -side top -fill x
4643 pack .vpane.lower.commarea.buttons -side left -fill y
4645 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4646 -command do_rescan \
4648 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4649 lappend disable_on_lock \
4650 {.vpane.lower.commarea.buttons.rescan conf -state}
4652 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4653 -command do_add_all \
4655 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4656 lappend disable_on_lock \
4657 {.vpane.lower.commarea.buttons.incall conf -state}
4659 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4660 -command do_signoff \
4662 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4664 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4665 -command do_commit \
4667 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4668 lappend disable_on_lock \
4669 {.vpane.lower.commarea.buttons.commit conf -state}
4671 # -- Commit Message Buffer
4673 frame .vpane.lower.commarea.buffer
4674 frame .vpane.lower.commarea.buffer.header
4675 set ui_comm .vpane.lower.commarea.buffer.t
4676 set ui_coml .vpane.lower.commarea.buffer.header.l
4677 radiobutton .vpane.lower.commarea.buffer.header.new \
4678 -text {New Commit} \
4679 -command do_select_commit_type \
4680 -variable selected_commit_type \
4683 lappend disable_on_lock \
4684 [list .vpane.lower.commarea.buffer.header.new conf -state]
4685 radiobutton .vpane.lower.commarea.buffer.header.amend \
4686 -text {Amend Last Commit} \
4687 -command do_select_commit_type \
4688 -variable selected_commit_type \
4691 lappend disable_on_lock \
4692 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4697 proc trace_commit_type {varname args} {
4698 global ui_coml commit_type
4699 switch -glob -- $commit_type {
4700 initial {set txt {Initial Commit Message:}}
4701 amend {set txt {Amended Commit Message:}}
4702 amend-initial {set txt {Amended Initial Commit Message:}}
4703 amend-merge {set txt {Amended Merge Commit Message:}}
4704 merge {set txt {Merge Commit Message:}}
4705 * {set txt {Commit Message:}}
4707 $ui_coml conf -text $txt
4709 trace add variable commit_type write trace_commit_type
4710 pack $ui_coml -side left -fill x
4711 pack .vpane.lower.commarea.buffer.header.amend -side right
4712 pack .vpane.lower.commarea.buffer.header.new -side right
4714 text $ui_comm -background white -borderwidth 1 \
4717 -autoseparators true \
4719 -width 75 -height 9 -wrap none \
4721 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4722 scrollbar .vpane.lower.commarea.buffer.sby \
4723 -command [list $ui_comm yview]
4724 pack .vpane.lower.commarea.buffer.header -side top -fill x
4725 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4726 pack $ui_comm -side left -fill y
4727 pack .vpane.lower.commarea.buffer -side left -fill y
4729 # -- Commit Message Buffer Context Menu
4731 set ctxm .vpane.lower.commarea.buffer.ctxm
4732 menu $ctxm -tearoff 0
4736 -command {tk_textCut $ui_comm}
4740 -command {tk_textCopy $ui_comm}
4744 -command {tk_textPaste $ui_comm}
4748 -command {$ui_comm delete sel.first sel.last}
4751 -label {Select All} \
4753 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4758 $ui_comm tag add sel 0.0 end
4759 tk_textCopy $ui_comm
4760 $ui_comm tag remove sel 0.0 end
4767 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
4771 set current_diff_path {}
4772 set current_diff_side {}
4773 set diff_actions [list]
4774 proc trace_current_diff_path {varname args} {
4775 global current_diff_path diff_actions file_states
4776 if {$current_diff_path eq {}} {
4782 set p $current_diff_path
4783 set s [mapdesc [lindex $file_states($p) 0] $p]
4785 set p [escape_path $p]
4789 .vpane.lower.diff.header.status configure -text $s
4790 .vpane.lower.diff.header.file configure -text $f
4791 .vpane.lower.diff.header.path configure -text $p
4792 foreach w $diff_actions {
4796 trace add variable current_diff_path write trace_current_diff_path
4798 frame .vpane.lower.diff.header -background orange
4799 label .vpane.lower.diff.header.status \
4800 -background orange \
4801 -width $max_status_desc \
4805 label .vpane.lower.diff.header.file \
4806 -background orange \
4810 label .vpane.lower.diff.header.path \
4811 -background orange \
4815 pack .vpane.lower.diff.header.status -side left
4816 pack .vpane.lower.diff.header.file -side left
4817 pack .vpane.lower.diff.header.path -fill x
4818 set ctxm .vpane.lower.diff.header.ctxm
4819 menu $ctxm -tearoff 0
4828 -- $current_diff_path
4830 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4831 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
4835 frame .vpane.lower.diff.body
4836 set ui_diff .vpane.lower.diff.body.t
4837 text $ui_diff -background white -borderwidth 0 \
4838 -width 80 -height 15 -wrap none \
4840 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4841 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4843 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4844 -command [list $ui_diff xview]
4845 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4846 -command [list $ui_diff yview]
4847 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4848 pack .vpane.lower.diff.body.sby -side right -fill y
4849 pack $ui_diff -side left -fill both -expand 1
4850 pack .vpane.lower.diff.header -side top -fill x
4851 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4853 $ui_diff tag conf d_cr -elide true
4854 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4855 $ui_diff tag conf d_+ -foreground {#00a000}
4856 $ui_diff tag conf d_- -foreground red
4858 $ui_diff tag conf d_++ -foreground {#00a000}
4859 $ui_diff tag conf d_-- -foreground red
4860 $ui_diff tag conf d_+s \
4861 -foreground {#00a000} \
4862 -background {#e2effa}
4863 $ui_diff tag conf d_-s \
4865 -background {#e2effa}
4866 $ui_diff tag conf d_s+ \
4867 -foreground {#00a000} \
4869 $ui_diff tag conf d_s- \
4873 $ui_diff tag conf d<<<<<<< \
4874 -foreground orange \
4876 $ui_diff tag conf d======= \
4877 -foreground orange \
4879 $ui_diff tag conf d>>>>>>> \
4880 -foreground orange \
4883 $ui_diff tag raise sel
4885 # -- Diff Body Context Menu
4887 set ctxm .vpane.lower.diff.body.ctxm
4888 menu $ctxm -tearoff 0
4892 -command reshow_diff
4893 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4897 -command {tk_textCopy $ui_diff}
4898 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4900 -label {Select All} \
4902 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4903 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4908 $ui_diff tag add sel 0.0 end
4909 tk_textCopy $ui_diff
4910 $ui_diff tag remove sel 0.0 end
4912 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4915 -label {Apply/Reverse Hunk} \
4917 -command {apply_hunk $cursorX $cursorY}
4918 set ui_diff_applyhunk [$ctxm index last]
4919 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4922 -label {Decrease Font Size} \
4924 -command {incr_font_size font_diff -1}
4925 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4927 -label {Increase Font Size} \
4929 -command {incr_font_size font_diff 1}
4930 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4933 -label {Show Less Context} \
4935 -command {if {$repo_config(gui.diffcontext) >= 2} {
4936 incr repo_config(gui.diffcontext) -1
4939 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4941 -label {Show More Context} \
4944 incr repo_config(gui.diffcontext)
4947 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4949 $ctxm add command -label {Options...} \
4952 bind_button3 $ui_diff "
4955 if {\
$ui_index eq \
$current_diff_side} {
4956 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
4958 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
4960 tk_popup
$ctxm %X
%Y
4962 unset ui_diff_applyhunk
4966 set ui_status_value {Initializing...}
4967 label .status -textvariable ui_status_value \
4973 pack .status -anchor w -side bottom -fill x
4978 set gm $repo_config(gui.geometry)
4979 wm geometry . [lindex $gm 0]
4980 .vpane sash place 0 \
4981 [lindex [.vpane sash coord 0] 0] \
4983 .vpane.files sash place 0 \
4985 [lindex [.vpane.files sash coord 0] 1]
4991 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4992 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4993 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4994 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4995 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4996 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4997 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4998 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4999 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
5000 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5001 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5003 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
5004 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
5005 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
5006 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
5007 bind $ui_diff <$M1B-Key-v> {break}
5008 bind $ui_diff <$M1B-Key-V> {break}
5009 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
5010 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
5011 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
5012 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
5013 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
5014 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
5015 bind $ui_diff <Button-1> {focus %W}
5017 if {!$single_commit} {
5018 bind . <$M1B-Key-n> do_create_branch
5019 bind . <$M1B-Key-N> do_create_branch
5022 bind . <Destroy> do_quit
5023 bind all <Key-F5> do_rescan
5024 bind all <$M1B-Key-r> do_rescan
5025 bind all <$M1B-Key-R> do_rescan
5026 bind . <$M1B-Key-s> do_signoff
5027 bind . <$M1B-Key-S> do_signoff
5028 bind . <$M1B-Key-i> do_add_all
5029 bind . <$M1B-Key-I> do_add_all
5030 bind . <$M1B-Key-Return> do_commit
5031 bind all <$M1B-Key-q> do_quit
5032 bind all <$M1B-Key-Q> do_quit
5033 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
5034 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
5035 foreach i [list $ui_index $ui_workdir] {
5036 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
5037 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
5038 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
5042 set file_lists($ui_index) [list]
5043 set file_lists($ui_workdir) [list]
5047 set MERGE_HEAD [list]
5050 set current_branch {}
5051 set current_diff_path {}
5052 set selected_commit_type new
5054 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
5055 focus -force $ui_comm
5057 # -- Warn the user about environmental problems. Cygwin's Tcl
5058 # does *not* pass its env array onto any processes it spawns.
5059 # This means that git processes get none of our environment.
5064 set msg "Possible environment issues exist.
5066 The following environment variables are probably
5067 going to be ignored by any Git subprocess run
5071 foreach name [array names env] {
5072 switch -regexp -- $name {
5073 {^GIT_INDEX_FILE$} -
5074 {^GIT_OBJECT_DIRECTORY$} -
5075 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
5077 {^GIT_EXTERNAL_DIFF$} -
5081 {^GIT_CONFIG_LOCAL$} -
5082 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
5083 append msg " - $name\n"
5086 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
5087 append msg " - $name\n"
5089 set suggest_user $name
5093 if {$ignored_env > 0} {
5095 This is due to a known issue with the
5096 Tcl binary distributed by Cygwin.
"
5098 if {$suggest_user ne {}} {
5101 A good replacement
for $suggest_user
5102 is placing values
for the user.name and
5103 user.email settings into your personal
5109 unset ignored_env msg suggest_user name
5112 # -- Only initialize complex UI if we are going to stay running.
5114 if {!$single_commit} {
5118 populate_branch_menu
5123 # -- Only suggest a gc run if we are going to stay running.
5125 if {!$single_commit} {
5126 set object_limit 2000
5127 if {[is_Windows]} {set object_limit 200}
5128 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
5129 if {$objects_current >= $object_limit} {
5131 "This repository currently has
$objects_current loose objects.
5133 To maintain optimal performance it is strongly
5134 recommended that you
compress the database
5135 when
more than
$object_limit loose objects exist.
5137 Compress the database now?
"] eq yes} {
5141 unset object_limit _junk objects_current
5144 lock_index begin-read