2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GIT_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
9 This program is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
2 of the License
, or
12 (at your option
) any later version.
14 This program is distributed
in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License
for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program
; if not
, write to the Free Software
21 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
23 ######################################################################
27 set _appname
[lindex
[file split $argv0] end
]
41 return [eval [concat
[list
file join $_gitdir] $args]]
49 ######################################################################
53 proc is_many_config
{name
} {
54 switch
-glob -- $name {
63 proc load_config
{include_global
} {
64 global repo_config global_config default_config
66 array
unset global_config
67 if {$include_global} {
69 set fd_rc
[open
"| git repo-config --global --list" r
]
70 while {[gets
$fd_rc line
] >= 0} {
71 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
72 if {[is_many_config
$name]} {
73 lappend global_config
($name) $value
75 set global_config
($name) $value
83 array
unset repo_config
85 set fd_rc
[open
"| git repo-config --list" r
]
86 while {[gets
$fd_rc line
] >= 0} {
87 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
88 if {[is_many_config
$name]} {
89 lappend repo_config
($name) $value
91 set repo_config
($name) $value
98 foreach name
[array names default_config
] {
99 if {[catch
{set v
$global_config($name)}]} {
100 set global_config
($name) $default_config($name)
102 if {[catch
{set v
$repo_config($name)}]} {
103 set repo_config
($name) $default_config($name)
108 proc save_config
{} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
113 foreach option
$font_descs {
114 set name
[lindex
$option 0]
115 set font
[lindex
$option 1]
116 font configure
$font \
117 -family $global_config_new(gui.
$font^^family
) \
118 -size $global_config_new(gui.
$font^^size
)
119 font configure
${font}bold \
120 -family $global_config_new(gui.
$font^^family
) \
121 -size $global_config_new(gui.
$font^^size
)
122 set global_config_new
(gui.
$name) [font configure
$font]
123 unset global_config_new
(gui.
$font^^family
)
124 unset global_config_new
(gui.
$font^^size
)
127 foreach name
[array names default_config
] {
128 set value
$global_config_new($name)
129 if {$value ne
$global_config($name)} {
130 if {$value eq
$default_config($name)} {
131 catch
{exec git repo-config
--global --unset $name}
133 regsub
-all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
144 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
150 regsub -all "\
[{}\
]" $value {"} value
151 exec git repo-config
$name $value
153 set repo_config
($name) $value
158 proc error_popup
{msg
} {
160 if {[reponame
] ne
{}} {
161 append title
" ([reponame])"
163 set cmd
[list tk_messageBox \
166 -title "$title: error" \
168 if {[winfo ismapped .
]} {
169 lappend cmd
-parent .
174 proc warn_popup
{msg
} {
176 if {[reponame
] ne
{}} {
177 append title
" ([reponame])"
179 set cmd
[list tk_messageBox \
182 -title "$title: warning" \
184 if {[winfo ismapped .
]} {
185 lappend cmd
-parent .
190 proc info_popup
{msg
} {
192 if {[reponame
] ne
{}} {
193 append title
" ([reponame])"
203 proc ask_popup
{msg
} {
205 if {[reponame
] ne
{}} {
206 append title
" ([reponame])"
208 return [tk_messageBox \
216 ######################################################################
220 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
221 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
222 catch
{wm withdraw .
}
223 error_popup
"Cannot find the git directory:\n\n$err"
226 if {![file isdirectory
$_gitdir]} {
227 catch
{wm withdraw .
}
228 error_popup
"Git directory not found:\n\n$_gitdir"
231 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
232 catch
{wm withdraw .
}
233 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
236 if {[catch
{cd [file dirname $_gitdir]} err
]} {
237 catch
{wm withdraw .
}
238 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
241 set _reponame
[lindex
[file split \
242 [file normalize
[file dirname $_gitdir]]] \
246 if {[appname
] eq
{git-citool
}} {
250 ######################################################################
258 set disable_on_lock
[list
]
259 set index_lock_type none
261 proc lock_index
{type} {
262 global index_lock_type disable_on_lock
264 if {$index_lock_type eq
{none
}} {
265 set index_lock_type
$type
266 foreach w
$disable_on_lock {
267 uplevel
#0 $w disabled
270 } elseif
{$index_lock_type eq
"begin-$type"} {
271 set index_lock_type
$type
277 proc unlock_index
{} {
278 global index_lock_type disable_on_lock
280 set index_lock_type none
281 foreach w
$disable_on_lock {
286 ######################################################################
290 proc repository_state
{ctvar hdvar mhvar
} {
291 global current_branch
292 upvar
$ctvar ct
$hdvar hd
$mhvar mh
296 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
297 set current_branch
{}
299 regsub ^refs
/((heads|tags|remotes
)/)? \
305 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
311 set merge_head
[gitdir MERGE_HEAD
]
312 if {[file exists
$merge_head]} {
314 set fd_mh
[open
$merge_head r
]
315 while {[gets
$fd_mh line
] >= 0} {
326 global PARENT empty_tree
328 set p
[lindex
$PARENT 0]
332 if {$empty_tree eq
{}} {
333 set empty_tree
[exec git mktree
<< {}]
338 proc rescan
{after
{honor_trustmtime
1}} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_workdir ui_status_value ui_comm
341 global rescan_active file_states
344 if {$rescan_active > 0 ||
![lock_index
read]} return
346 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend
* $commit_type]
348 && $newType eq
{normal
}
349 && $newHEAD eq
$HEAD} {
353 set MERGE_HEAD
$newMERGE_HEAD
354 set commit_type
$newType
357 array
unset file_states
359 if {![$ui_comm edit modified
]
360 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
361 if {[load_message GITGUI_MSG
]} {
362 } elseif
{[load_message MERGE_MSG
]} {
363 } elseif
{[load_message SQUASH_MSG
]} {
366 $ui_comm edit modified false
369 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
370 rescan_stage2
{} $after
373 set ui_status_value
{Refreshing
file status...
}
374 set cmd
[list git update-index
]
376 lappend cmd
--unmerged
377 lappend cmd
--ignore-missing
378 lappend cmd
--refresh
379 set fd_rf
[open
"| $cmd" r
]
380 fconfigure
$fd_rf -blocking 0 -translation binary
381 fileevent
$fd_rf readable \
382 [list rescan_stage2
$fd_rf $after]
386 proc rescan_stage2
{fd after
} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
392 if {![eof
$fd]} return
396 set ls_others
[list | git ls-files
--others -z \
397 --exclude-per-directory=.gitignore
]
398 set info_exclude
[gitdir info exclude
]
399 if {[file readable
$info_exclude]} {
400 lappend ls_others
"--exclude-from=$info_exclude"
408 set ui_status_value
{Scanning
for modified files ...
}
409 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
410 set fd_df
[open
"| git diff-files -z" r
]
411 set fd_lo
[open
$ls_others r
]
413 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
414 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
415 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
416 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
417 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
418 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
421 proc load_message
{file} {
425 if {[file isfile
$f]} {
426 if {[catch
{set fd
[open
$f r
]}]} {
429 set content
[string trim
[read $fd]]
431 $ui_comm delete
0.0 end
432 $ui_comm insert end
$content
438 proc read_diff_index
{fd after
} {
441 append buf_rdi
[read $fd]
443 set n
[string length
$buf_rdi]
445 set z1
[string first
"\0" $buf_rdi $c]
448 set z2
[string first
"\0" $buf_rdi $z1]
452 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
453 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
455 [encoding convertfrom
$p] \
457 [list
[lindex
$i 0] [lindex
$i 2]] \
463 set buf_rdi
[string range
$buf_rdi $c end
]
468 rescan_done
$fd buf_rdi
$after
471 proc read_diff_files
{fd after
} {
474 append buf_rdf
[read $fd]
476 set n
[string length
$buf_rdf]
478 set z1
[string first
"\0" $buf_rdf $c]
481 set z2
[string first
"\0" $buf_rdf $z1]
485 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
486 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
488 [encoding convertfrom
$p] \
491 [list
[lindex
$i 0] [lindex
$i 2]]
496 set buf_rdf
[string range
$buf_rdf $c end
]
501 rescan_done
$fd buf_rdf
$after
504 proc read_ls_others
{fd after
} {
507 append buf_rlo
[read $fd]
508 set pck
[split $buf_rlo "\0"]
509 set buf_rlo
[lindex
$pck end
]
510 foreach p
[lrange
$pck 0 end-1
] {
511 merge_state
[encoding convertfrom
$p] ?O
513 rescan_done
$fd buf_rlo
$after
516 proc rescan_done
{fd buf after
} {
518 global file_states repo_config
521 if {![eof
$fd]} return
524 if {[incr rescan_active
-1] > 0} return
533 proc prune_selection
{} {
534 global file_states selected_paths
536 foreach path
[array names selected_paths
] {
537 if {[catch
{set still_here
$file_states($path)}]} {
538 unset selected_paths
($path)
543 ######################################################################
548 global ui_diff current_diff_path current_diff_header
549 global ui_index ui_workdir
551 $ui_diff conf
-state normal
552 $ui_diff delete
0.0 end
553 $ui_diff conf
-state disabled
555 set current_diff_path
{}
556 set current_diff_header
{}
558 $ui_index tag remove in_diff
0.0 end
559 $ui_workdir tag remove in_diff
0.0 end
562 proc reshow_diff
{} {
563 global ui_status_value file_states file_lists
564 global current_diff_path current_diff_side
566 set p
$current_diff_path
568 ||
$current_diff_side eq
{}
569 ||
[catch
{set s
$file_states($p)}]
570 ||
[lsearch
-sorted $file_lists($current_diff_side) $p] == -1} {
573 show_diff
$p $current_diff_side
577 proc handle_empty_diff
{} {
578 global current_diff_path file_states file_lists
580 set path
$current_diff_path
581 set s
$file_states($path)
582 if {[lindex
$s 0] ne
{_M
}} return
584 info_popup
"No differences detected.
586 [short_path $path] has no changes.
588 The modification date of this file was updated
589 by another application, but the content within
590 the file was not changed.
592 A rescan will be automatically started to find
593 other files which may have the same state."
596 display_file
$path __
597 rescan
{set ui_status_value
{Ready.
}} 0
600 proc show_diff
{path w
{lno
{}}} {
601 global file_states file_lists
602 global is_3way_diff diff_active repo_config
603 global ui_diff ui_status_value ui_index ui_workdir
604 global current_diff_path current_diff_side current_diff_header
606 if {$diff_active ||
![lock_index
read]} return
609 if {$w eq
{} ||
$lno == {}} {
610 foreach w
[array names file_lists
] {
611 set lno
[lsearch
-sorted $file_lists($w) $path]
618 if {$w ne
{} && $lno >= 1} {
619 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
622 set s
$file_states($path)
626 set current_diff_path
$path
627 set current_diff_side
$w
628 set current_diff_header
{}
629 set ui_status_value
"Loading diff of [escape_path $path]..."
631 # - Git won't give us the diff, there's nothing to compare to!
634 set max_sz
[expr {128 * 1024}]
636 set fd
[open
$path r
]
637 set content
[read $fd $max_sz]
639 set sz
[file size
$path]
643 set ui_status_value
"Unable to display [escape_path $path]"
644 error_popup
"Error loading file:\n\n$err"
647 $ui_diff conf
-state normal
648 if {![catch
{set type [exec file $path]}]} {
649 set n
[string length
$path]
650 if {[string equal
-length $n $path $type]} {
651 set type [string range
$type $n end
]
652 regsub
{^
:?\s
*} $type {} type
654 $ui_diff insert end
"* $type\n" d_@
656 if {[string first
"\0" $content] != -1} {
657 $ui_diff insert end \
658 "* Binary file (not showing content)." \
662 $ui_diff insert end \
663 "* Untracked file is $sz bytes.
664 * Showing only first $max_sz bytes.
667 $ui_diff insert end
$content
669 $ui_diff insert end
"
670 * Untracked file clipped here by [appname].
671 * To see the entire file, use an external editor.
675 $ui_diff conf
-state disabled
678 set ui_status_value
{Ready.
}
683 if {$w eq
$ui_index} {
684 lappend cmd diff-index
686 } elseif
{$w eq
$ui_workdir} {
687 if {[string index
$m 0] eq
{U
}} {
690 lappend cmd diff-files
695 lappend cmd
--no-color
696 if {$repo_config(gui.diffcontext
) > 0} {
697 lappend cmd
"-U$repo_config(gui.diffcontext)"
699 if {$w eq
$ui_index} {
705 if {[catch
{set fd
[open
$cmd r
]} err
]} {
708 set ui_status_value
"Unable to display [escape_path $path]"
709 error_popup
"Error loading diff:\n\n$err"
717 fileevent
$fd readable
[list read_diff
$fd]
720 proc read_diff
{fd
} {
721 global ui_diff ui_status_value diff_active
722 global is_3way_diff current_diff_header
724 $ui_diff conf
-state normal
725 while {[gets
$fd line
] >= 0} {
726 # -- Cleanup uninteresting diff header lines.
728 if { [string match
{diff --git *} $line]
729 ||
[string match
{diff --cc *} $line]
730 ||
[string match
{diff --combined *} $line]
731 ||
[string match
{--- *} $line]
732 ||
[string match
{+++ *} $line]} {
733 append current_diff_header
$line "\n"
736 if {[string match
{index
*} $line]} continue
737 if {$line eq
{deleted
file mode
120000}} {
738 set line
"deleted symlink"
741 # -- Automatically detect if this is a 3 way diff.
743 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
745 if {[string match
{mode
*} $line]
746 ||
[string match
{new
file *} $line]
747 ||
[string match
{deleted
file *} $line]
748 ||
[string match
{Binary files
* and
* differ
} $line]
749 ||
$line eq
{\ No newline
at end of
file}
750 ||
[regexp
{^\
* Unmerged path
} $line]} {
752 } elseif
{$is_3way_diff} {
753 set op
[string range
$line 0 1]
763 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
764 set line
[string replace
$line 0 1 { }]
771 puts
"error: Unhandled 3 way diff marker: {$op}"
776 set op
[string index
$line 0]
782 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
783 set line
[string replace
$line 0 0 { }]
790 puts
"error: Unhandled 2 way diff marker: {$op}"
795 $ui_diff insert end
$line $tags
796 if {[string index
$line end
] eq
"\r"} {
797 $ui_diff tag add d_cr
{end
- 2c
}
799 $ui_diff insert end
"\n" $tags
801 $ui_diff conf
-state disabled
807 set ui_status_value
{Ready.
}
809 if {[$ui_diff index end
] eq
{2.0}} {
815 proc apply_hunk
{x y
} {
816 global current_diff_path current_diff_header current_diff_side
817 global ui_diff ui_index file_states
819 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
820 if {![lock_index apply_hunk
]} return
822 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
823 set mi
[lindex
$file_states($current_diff_path) 0]
824 if {$current_diff_side eq
$ui_index} {
826 lappend apply_cmd
--reverse
827 if {[string index
$mi 0] ne
{M
}} {
833 if {[string index
$mi 1] ne
{M
}} {
839 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
840 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
846 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
852 set p
[open
"| $apply_cmd" w
]
853 fconfigure
$p -translation binary
-encoding binary
854 puts
-nonewline $p $current_diff_header
855 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
857 error_popup
"Failed to $mode selected hunk.\n\n$err"
862 $ui_diff conf
-state normal
863 $ui_diff delete
$s_lno $e_lno
864 $ui_diff conf
-state disabled
866 if {[$ui_diff get
1.0 end
] eq
"\n"} {
872 if {$current_diff_side eq
$ui_index} {
874 } elseif
{[string index
$mi 0] eq
{_
}} {
880 display_file
$current_diff_path $mi
886 ######################################################################
890 proc load_last_commit
{} {
891 global HEAD PARENT MERGE_HEAD commit_type ui_comm
894 if {[llength
$PARENT] == 0} {
895 error_popup
{There is nothing to amend.
897 You are about to create the initial commit.
898 There is no commit before this to amend.
903 repository_state curType curHEAD curMERGE_HEAD
904 if {$curType eq
{merge
}} {
905 error_popup
{Cannot amend
while merging.
907 You are currently
in the middle of a merge that
908 has not been fully completed. You cannot amend
909 the prior commit unless you first abort the
910 current merge activity.
918 set fd
[open
"| git cat-file commit $curHEAD" r
]
919 fconfigure
$fd -encoding binary
-translation lf
920 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
923 while {[gets
$fd line
] > 0} {
924 if {[string match
{parent
*} $line]} {
925 lappend parents
[string range
$line 7 end
]
926 } elseif
{[string match
{encoding
*} $line]} {
927 set enc
[string tolower
[string range
$line 9 end
]]
930 fconfigure
$fd -encoding $enc
931 set msg
[string trim
[read $fd]]
934 error_popup
"Error loading commit data for amend:\n\n$err"
940 set MERGE_HEAD
[list
]
941 switch
-- [llength
$parents] {
942 0 {set commit_type amend-initial
}
943 1 {set commit_type amend
}
944 default
{set commit_type amend-merge
}
947 $ui_comm delete
0.0 end
948 $ui_comm insert end
$msg
950 $ui_comm edit modified false
951 rescan
{set ui_status_value
{Ready.
}}
954 proc create_new_commit
{} {
955 global commit_type ui_comm
957 set commit_type normal
958 $ui_comm delete
0.0 end
960 $ui_comm edit modified false
961 rescan
{set ui_status_value
{Ready.
}}
964 set GIT_COMMITTER_IDENT
{}
966 proc committer_ident
{} {
967 global GIT_COMMITTER_IDENT
969 if {$GIT_COMMITTER_IDENT eq
{}} {
970 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
971 error_popup
"Unable to obtain your identity:\n\n$err"
974 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
975 $me me GIT_COMMITTER_IDENT
]} {
976 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
981 return $GIT_COMMITTER_IDENT
984 proc commit_tree
{} {
985 global HEAD commit_type file_states ui_comm repo_config
986 global ui_status_value pch_error
988 if {![lock_index update
]} return
989 if {[committer_ident
] eq
{}} return
991 # -- Our in memory state should match the repository.
993 repository_state curType curHEAD curMERGE_HEAD
994 if {[string match amend
* $commit_type]
995 && $curType eq
{normal
}
996 && $curHEAD eq
$HEAD} {
997 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
998 info_popup
{Last scanned state does not match repository state.
1000 Another Git program has modified this repository
1001 since the last scan. A rescan must be performed
1002 before another commit can be created.
1004 The rescan will be automatically started now.
1007 rescan
{set ui_status_value
{Ready.
}}
1011 # -- At least one file should differ in the index.
1014 foreach path
[array names file_states
] {
1015 switch
-glob -- [lindex
$file_states($path) 0] {
1019 M?
{set files_ready
1}
1021 error_popup
"Unmerged files cannot be committed.
1023 File [short_path $path] has merge conflicts.
1024 You must resolve them and add the file before committing.
1030 error_popup
"Unknown file state [lindex $s 0] detected.
1032 File [short_path $path] cannot be committed by this program.
1037 if {!$files_ready} {
1038 info_popup
{No changes to commit.
1040 You must add
at least
1 file before you can commit.
1046 # -- A message is required.
1048 set msg
[string trim
[$ui_comm get
1.0 end
]]
1050 error_popup
{Please supply a commit message.
1052 A good commit message has the following format
:
1054 - First line
: Describe
in one sentance what you did.
1055 - Second line
: Blank
1056 - Remaining lines
: Describe why this change is good.
1062 # -- Run the pre-commit hook.
1064 set pchook
[gitdir hooks pre-commit
]
1066 # On Cygwin [file executable] might lie so we need to ask
1067 # the shell if the hook is executable. Yes that's annoying.
1069 if {[is_Windows
] && [file isfile
$pchook]} {
1070 set pchook
[list sh
-c [concat \
1071 "if test -x \"$pchook\";" \
1072 "then exec \"$pchook\" 2>&1;" \
1074 } elseif
{[file executable
$pchook]} {
1075 set pchook
[list
$pchook |
& cat]
1077 commit_writetree
$curHEAD $msg
1081 set ui_status_value
{Calling pre-commit hook...
}
1083 set fd_ph
[open
"| $pchook" r
]
1084 fconfigure
$fd_ph -blocking 0 -translation binary
1085 fileevent
$fd_ph readable \
1086 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1089 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1090 global pch_error ui_status_value
1092 append pch_error
[read $fd_ph]
1093 fconfigure
$fd_ph -blocking 1
1095 if {[catch
{close
$fd_ph}]} {
1096 set ui_status_value
{Commit declined by pre-commit hook.
}
1097 hook_failed_popup pre-commit
$pch_error
1100 commit_writetree
$curHEAD $msg
1105 fconfigure
$fd_ph -blocking 0
1108 proc commit_writetree
{curHEAD msg
} {
1109 global ui_status_value
1111 set ui_status_value
{Committing changes...
}
1112 set fd_wt
[open
"| git write-tree" r
]
1113 fileevent
$fd_wt readable \
1114 [list commit_committree
$fd_wt $curHEAD $msg]
1117 proc commit_committree
{fd_wt curHEAD msg
} {
1118 global HEAD PARENT MERGE_HEAD commit_type
1119 global single_commit all_heads current_branch
1120 global ui_status_value ui_comm selected_commit_type
1121 global file_states selected_paths rescan_active
1125 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1126 error_popup
"write-tree failed:\n\n$err"
1127 set ui_status_value
{Commit failed.
}
1132 # -- Build the message.
1134 set msg_p
[gitdir COMMIT_EDITMSG
]
1135 set msg_wt
[open
$msg_p w
]
1136 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1139 fconfigure
$msg_wt -encoding $enc -translation binary
1140 puts
-nonewline $msg_wt $msg
1143 # -- Create the commit.
1145 set cmd
[list git commit-tree
$tree_id]
1146 set parents
[concat
$PARENT $MERGE_HEAD]
1147 if {[llength
$parents] > 0} {
1148 foreach p
$parents {
1152 # git commit-tree writes to stderr during initial commit.
1153 lappend cmd
2>/dev
/null
1156 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1157 error_popup
"commit-tree failed:\n\n$err"
1158 set ui_status_value
{Commit failed.
}
1163 # -- Update the HEAD ref.
1166 if {$commit_type ne
{normal
}} {
1167 append reflogm
" ($commit_type)"
1169 set i
[string first
"\n" $msg]
1171 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1173 append reflogm
{: } $msg
1175 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1176 if {[catch
{eval exec $cmd} err
]} {
1177 error_popup
"update-ref failed:\n\n$err"
1178 set ui_status_value
{Commit failed.
}
1183 # -- Make sure our current branch exists.
1185 if {$commit_type eq
{initial
}} {
1186 lappend all_heads
$current_branch
1187 set all_heads
[lsort
-unique $all_heads]
1188 populate_branch_menu
1191 # -- Cleanup after ourselves.
1193 catch
{file delete
$msg_p}
1194 catch
{file delete
[gitdir MERGE_HEAD
]}
1195 catch
{file delete
[gitdir MERGE_MSG
]}
1196 catch
{file delete
[gitdir SQUASH_MSG
]}
1197 catch
{file delete
[gitdir GITGUI_MSG
]}
1199 # -- Let rerere do its thing.
1201 if {[file isdirectory
[gitdir rr-cache
]]} {
1202 catch
{exec git rerere
}
1205 # -- Run the post-commit hook.
1207 set pchook
[gitdir hooks post-commit
]
1208 if {[is_Windows
] && [file isfile
$pchook]} {
1209 set pchook
[list sh
-c [concat \
1210 "if test -x \"$pchook\";" \
1211 "then exec \"$pchook\";" \
1213 } elseif
{![file executable
$pchook]} {
1216 if {$pchook ne
{}} {
1217 catch
{exec $pchook &}
1220 $ui_comm delete
0.0 end
1222 $ui_comm edit modified false
1224 if {$single_commit} do_quit
1226 # -- Update in memory status
1228 set selected_commit_type new
1229 set commit_type normal
1232 set MERGE_HEAD
[list
]
1234 foreach path
[array names file_states
] {
1235 set s
$file_states($path)
1237 switch
-glob -- $m {
1245 unset file_states
($path)
1246 catch
{unset selected_paths
($path)}
1249 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1255 set file_states
($path) [list \
1256 _
[string index
$m 1] \
1267 set ui_status_value \
1268 "Changes committed as [string range $cmt_id 0 7]."
1271 ######################################################################
1275 proc fetch_from
{remote
} {
1276 set w
[new_console
"fetch $remote" \
1277 "Fetching new changes from $remote"]
1278 set cmd
[list git fetch
]
1280 console_exec
$w $cmd
1283 proc pull_remote
{remote branch
} {
1284 global HEAD commit_type file_states repo_config
1286 if {![lock_index update
]} return
1288 # -- Our in memory state should match the repository.
1290 repository_state curType curHEAD curMERGE_HEAD
1291 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1292 info_popup
{Last scanned state does not match repository state.
1294 Another Git program has modified this repository
1295 since the last scan. A rescan must be performed
1296 before a pull operation can be started.
1298 The rescan will be automatically started now.
1301 rescan
{set ui_status_value
{Ready.
}}
1305 # -- No differences should exist before a pull.
1307 if {[array size file_states
] != 0} {
1308 error_popup
{Uncommitted but modified files are present.
1310 You should not perform a pull with unmodified
1311 files
in your working directory as Git will be
1312 unable to recover from an incorrect merge.
1314 You should commit or revert all changes before
1315 starting a pull operation.
1321 set w
[new_console
"pull $remote $branch" \
1322 "Pulling new changes from branch $branch in $remote"]
1323 set cmd
[list git pull
]
1324 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1325 lappend cmd
--no-summary
1329 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1332 proc post_pull_remote
{remote branch success
} {
1333 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1334 global ui_status_value
1338 repository_state commit_type HEAD MERGE_HEAD
1340 set selected_commit_type new
1341 set ui_status_value
"Pulling $branch from $remote complete."
1343 rescan
[list
set ui_status_value \
1344 "Conflicts detected while pulling $branch from $remote."]
1348 proc push_to
{remote
} {
1349 set w
[new_console
"push $remote" \
1350 "Pushing changes to $remote"]
1351 set cmd
[list git push
]
1353 console_exec
$w $cmd
1356 ######################################################################
1360 proc mapicon
{w state path
} {
1363 if {[catch
{set r
$all_icons($state$w)}]} {
1364 puts
"error: no icon for $w state={$state} $path"
1370 proc mapdesc
{state path
} {
1373 if {[catch
{set r
$all_descs($state)}]} {
1374 puts
"error: no desc for state={$state} $path"
1380 proc escape_path
{path
} {
1381 regsub
-all "\n" $path "\\n" path
1385 proc short_path
{path
} {
1386 return [escape_path
[lindex
[file split $path] end
]]
1390 set null_sha1
[string repeat
0 40]
1392 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1393 global file_states next_icon_id null_sha1
1395 set s0
[string index
$new_state 0]
1396 set s1
[string index
$new_state 1]
1398 if {[catch
{set info
$file_states($path)}]} {
1400 set icon n
[incr next_icon_id
]
1402 set state
[lindex
$info 0]
1403 set icon
[lindex
$info 1]
1404 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1405 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1408 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1409 elseif
{$s0 eq
{_
}} {set s0 _
}
1411 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1412 elseif
{$s1 eq
{_
}} {set s1 _
}
1414 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1415 set head_info
[list
0 $null_sha1]
1416 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1417 && $head_info eq
{}} {
1418 set head_info
$index_info
1421 set file_states
($path) [list
$s0$s1 $icon \
1422 $head_info $index_info \
1427 proc display_file_helper
{w path icon_name old_m new_m
} {
1430 if {$new_m eq
{_
}} {
1431 set lno
[lsearch
-sorted $file_lists($w) $path]
1433 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1435 $w conf
-state normal
1436 $w delete
$lno.0 [expr {$lno + 1}].0
1437 $w conf
-state disabled
1439 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1440 lappend file_lists
($w) $path
1441 set file_lists
($w) [lsort
-unique $file_lists($w)]
1442 set lno
[lsearch
-sorted $file_lists($w) $path]
1444 $w conf
-state normal
1445 $w image create
$lno.0 \
1446 -align center
-padx 5 -pady 1 \
1448 -image [mapicon
$w $new_m $path]
1449 $w insert
$lno.1 "[escape_path $path]\n"
1450 $w conf
-state disabled
1451 } elseif
{$old_m ne
$new_m} {
1452 $w conf
-state normal
1453 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1454 $w conf
-state disabled
1458 proc display_file
{path state
} {
1459 global file_states selected_paths
1460 global ui_index ui_workdir
1462 set old_m
[merge_state
$path $state]
1463 set s
$file_states($path)
1464 set new_m
[lindex
$s 0]
1465 set icon_name
[lindex
$s 1]
1467 set o
[string index
$old_m 0]
1468 set n
[string index
$new_m 0]
1475 display_file_helper
$ui_index $path $icon_name $o $n
1477 if {[string index
$old_m 0] eq
{U
}} {
1480 set o
[string index
$old_m 1]
1482 if {[string index
$new_m 0] eq
{U
}} {
1485 set n
[string index
$new_m 1]
1487 display_file_helper
$ui_workdir $path $icon_name $o $n
1489 if {$new_m eq
{__
}} {
1490 unset file_states
($path)
1491 catch
{unset selected_paths
($path)}
1495 proc display_all_files_helper
{w path icon_name m
} {
1498 lappend file_lists
($w) $path
1499 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1500 $w image create end \
1501 -align center
-padx 5 -pady 1 \
1503 -image [mapicon
$w $m $path]
1504 $w insert end
"[escape_path $path]\n"
1507 proc display_all_files
{} {
1508 global ui_index ui_workdir
1509 global file_states file_lists
1512 $ui_index conf
-state normal
1513 $ui_workdir conf
-state normal
1515 $ui_index delete
0.0 end
1516 $ui_workdir delete
0.0 end
1519 set file_lists
($ui_index) [list
]
1520 set file_lists
($ui_workdir) [list
]
1522 foreach path
[lsort
[array names file_states
]] {
1523 set s
$file_states($path)
1525 set icon_name
[lindex
$s 1]
1527 set s
[string index
$m 0]
1528 if {$s ne
{U
} && $s ne
{_
}} {
1529 display_all_files_helper
$ui_index $path \
1533 if {[string index
$m 0] eq
{U
}} {
1536 set s
[string index
$m 1]
1539 display_all_files_helper
$ui_workdir $path \
1544 $ui_index conf
-state disabled
1545 $ui_workdir conf
-state disabled
1548 proc update_indexinfo
{msg pathList after
} {
1549 global update_index_cp ui_status_value
1551 if {![lock_index update
]} return
1553 set update_index_cp
0
1554 set pathList
[lsort
$pathList]
1555 set totalCnt
[llength
$pathList]
1556 set batch [expr {int
($totalCnt * .01) + 1}]
1557 if {$batch > 25} {set batch 25}
1559 set ui_status_value
[format \
1560 "$msg... %i/%i files (%.2f%%)" \
1564 set fd
[open
"| git update-index -z --index-info" w
]
1571 fileevent
$fd writable
[list \
1572 write_update_indexinfo \
1582 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1583 global update_index_cp ui_status_value
1584 global file_states current_diff_path
1586 if {$update_index_cp >= $totalCnt} {
1593 for {set i
$batch} \
1594 {$update_index_cp < $totalCnt && $i > 0} \
1596 set path
[lindex
$pathList $update_index_cp]
1597 incr update_index_cp
1599 set s
$file_states($path)
1600 switch
-glob -- [lindex
$s 0] {
1607 set info
[lindex
$s 2]
1608 if {$info eq
{}} continue
1610 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1611 display_file
$path $new
1614 set ui_status_value
[format \
1615 "$msg... %i/%i files (%.2f%%)" \
1618 [expr {100.0 * $update_index_cp / $totalCnt}]]
1621 proc update_index
{msg pathList after
} {
1622 global update_index_cp ui_status_value
1624 if {![lock_index update
]} return
1626 set update_index_cp
0
1627 set pathList
[lsort
$pathList]
1628 set totalCnt
[llength
$pathList]
1629 set batch [expr {int
($totalCnt * .01) + 1}]
1630 if {$batch > 25} {set batch 25}
1632 set ui_status_value
[format \
1633 "$msg... %i/%i files (%.2f%%)" \
1637 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1644 fileevent
$fd writable
[list \
1645 write_update_index \
1655 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1656 global update_index_cp ui_status_value
1657 global file_states current_diff_path
1659 if {$update_index_cp >= $totalCnt} {
1666 for {set i
$batch} \
1667 {$update_index_cp < $totalCnt && $i > 0} \
1669 set path
[lindex
$pathList $update_index_cp]
1670 incr update_index_cp
1672 switch
-glob -- [lindex
$file_states($path) 0] {
1678 if {[file exists
$path]} {
1687 puts
-nonewline $fd "[encoding convertto $path]\0"
1688 display_file
$path $new
1691 set ui_status_value
[format \
1692 "$msg... %i/%i files (%.2f%%)" \
1695 [expr {100.0 * $update_index_cp / $totalCnt}]]
1698 proc checkout_index
{msg pathList after
} {
1699 global update_index_cp ui_status_value
1701 if {![lock_index update
]} return
1703 set update_index_cp
0
1704 set pathList
[lsort
$pathList]
1705 set totalCnt
[llength
$pathList]
1706 set batch [expr {int
($totalCnt * .01) + 1}]
1707 if {$batch > 25} {set batch 25}
1709 set ui_status_value
[format \
1710 "$msg... %i/%i files (%.2f%%)" \
1714 set cmd
[list git checkout-index
]
1720 set fd
[open
"| $cmd " w
]
1727 fileevent
$fd writable
[list \
1728 write_checkout_index \
1738 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1739 global update_index_cp ui_status_value
1740 global file_states current_diff_path
1742 if {$update_index_cp >= $totalCnt} {
1749 for {set i
$batch} \
1750 {$update_index_cp < $totalCnt && $i > 0} \
1752 set path
[lindex
$pathList $update_index_cp]
1753 incr update_index_cp
1754 switch
-glob -- [lindex
$file_states($path) 0] {
1758 puts
-nonewline $fd "[encoding convertto $path]\0"
1759 display_file
$path ?_
1764 set ui_status_value
[format \
1765 "$msg... %i/%i files (%.2f%%)" \
1768 [expr {100.0 * $update_index_cp / $totalCnt}]]
1771 ######################################################################
1773 ## branch management
1775 proc is_tracking_branch
{name
} {
1776 global tracking_branches
1778 if {![catch
{set info
$tracking_branches($name)}]} {
1781 foreach t
[array names tracking_branches
] {
1782 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1789 proc load_all_heads
{} {
1792 set all_heads
[list
]
1793 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1794 while {[gets
$fd line
] > 0} {
1795 if {[is_tracking_branch
$line]} continue
1796 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1797 lappend all_heads
$name
1801 set all_heads
[lsort
$all_heads]
1804 proc populate_branch_menu
{} {
1805 global all_heads disable_on_lock
1808 set last
[$m index last
]
1809 for {set i
0} {$i <= $last} {incr i
} {
1810 if {[$m type $i] eq
{separator
}} {
1813 foreach a
$disable_on_lock {
1814 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1818 set disable_on_lock
$new_dol
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
1867 set newbranch
[string trim
[$w.desc.name_t get
0.0 end
]]
1868 if {$newbranch eq
{}
1869 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1873 -title [wm title
$w] \
1875 -message "Please supply a branch name."
1876 focus
$w.desc.name_t
1879 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1883 -title [wm title
$w] \
1885 -message "Branch '$newbranch' already exists."
1886 focus
$w.desc.name_t
1889 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1893 -title [wm title
$w] \
1895 -message "We do not like '$newbranch' as a branch name."
1896 focus
$w.desc.name_t
1901 switch
-- $create_branch_revtype {
1902 head {set rev $create_branch_head}
1903 tracking
{set rev $create_branch_trackinghead}
1904 expression
{set rev [string trim
[$w.from.exp_t get
0.0 end
]]}
1906 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1910 -title [wm title
$w] \
1912 -message "Invalid starting revision: $rev"
1915 set cmd
[list git update-ref
]
1917 lappend cmd
"branch: Created from $rev"
1918 lappend cmd
"refs/heads/$newbranch"
1920 lappend cmd
$null_sha1
1921 if {[catch
{eval exec $cmd} err
]} {
1925 -title [wm title
$w] \
1927 -message "Failed to create '$newbranch'.\n\n$err"
1931 lappend all_heads
$newbranch
1932 set all_heads
[lsort
$all_heads]
1933 populate_branch_menu
1935 if {$create_branch_checkout} {
1936 switch_branch
$newbranch
1940 proc radio_selector
{varname value args
} {
1941 upvar
#0 $varname var
1945 trace add variable create_branch_head
write \
1946 [list radio_selector create_branch_revtype
head]
1947 trace add variable create_branch_trackinghead
write \
1948 [list radio_selector create_branch_revtype tracking
]
1950 trace add variable delete_branch_head
write \
1951 [list radio_selector delete_branch_checktype
head]
1952 trace add variable delete_branch_trackinghead
write \
1953 [list radio_selector delete_branch_checktype tracking
]
1955 proc do_create_branch
{} {
1956 global all_heads current_branch repo_config
1957 global create_branch_checkout create_branch_revtype
1958 global create_branch_head create_branch_trackinghead
1960 set w .branch_editor
1962 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1964 label
$w.header
-text {Create New Branch
} \
1966 pack
$w.header
-side top
-fill x
1969 button
$w.buttons.create
-text Create \
1972 -command [list do_create_branch_action
$w]
1973 pack
$w.buttons.create
-side right
1974 button
$w.buttons.cancel
-text {Cancel
} \
1976 -command [list destroy
$w]
1977 pack
$w.buttons.cancel
-side right
-padx 5
1978 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1980 labelframe
$w.desc \
1981 -text {Branch Description
} \
1983 label
$w.desc.name_l
-text {Name
:} -font font_ui
1984 text
$w.desc.name_t \
1990 $w.desc.name_t insert
0.0 $repo_config(gui.newbranchtemplate
)
1991 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
1992 bind $w.desc.name_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
1993 bind $w.desc.name_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
1994 bind $w.desc.name_t
<Key-Return
> "do_create_branch_action $w;break"
1995 bind $w.desc.name_t
<Key
> {
1996 if {{%K
} ne
{BackSpace
}
1999 && {%K
} ne
{Return
}} {
2001 if {[string first
%A
{~^
:?
*[}] >= 0} break
2004 grid columnconfigure
$w.desc
1 -weight 1
2005 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2007 labelframe
$w.from \
2008 -text {Starting Revision
} \
2010 radiobutton
$w.from.head_r \
2011 -text {Local Branch
:} \
2013 -variable create_branch_revtype \
2015 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2016 grid
$w.from.head_r
$w.from.head_m
-sticky w
2017 set all_trackings
[all_tracking_branches
]
2018 if {$all_trackings ne
{}} {
2019 set create_branch_trackinghead
[lindex
$all_trackings 0]
2020 radiobutton
$w.from.tracking_r \
2021 -text {Tracking Branch
:} \
2023 -variable create_branch_revtype \
2025 eval tk_optionMenu
$w.from.tracking_m \
2026 create_branch_trackinghead \
2028 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2030 radiobutton
$w.from.exp_r \
2031 -text {Revision Expression
:} \
2033 -variable create_branch_revtype \
2035 text
$w.from.exp_t \
2041 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2042 bind $w.from.exp_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
2043 bind $w.from.exp_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
2044 bind $w.from.exp_t
<Key-Return
> "do_create_branch_action $w;break"
2045 bind $w.from.exp_t
<Key-space
> break
2046 bind $w.from.exp_t
<Key
> {set create_branch_revtype expression
}
2047 grid columnconfigure
$w.from
1 -weight 1
2048 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2050 labelframe
$w.postActions \
2051 -text {Post Creation Actions
} \
2053 checkbutton
$w.postActions.checkout \
2054 -text {Checkout after creation
} \
2055 -variable create_branch_checkout \
2057 pack
$w.postActions.checkout
-anchor nw
2058 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2060 set create_branch_checkout
1
2061 set create_branch_head
$current_branch
2062 set create_branch_revtype
head
2064 bind $w <Visibility
> "grab $w; focus $w.desc.name_t"
2065 bind $w <Key-Escape
> "destroy $w"
2066 bind $w <Key-Return
> "do_create_branch_action $w;break"
2067 wm title
$w "[appname] ([reponame]): Create Branch"
2071 proc do_delete_branch_action
{w
} {
2073 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2076 switch
-- $delete_branch_checktype {
2077 head {set check_rev
$delete_branch_head}
2078 tracking
{set check_rev
$delete_branch_trackinghead}
2079 always
{set check_rev
{:none
}}
2081 if {$check_rev eq
{:none
}} {
2083 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2087 -title [wm title
$w] \
2089 -message "Invalid check revision: $check_rev"
2093 set to_delete
[list
]
2094 set not_merged
[list
]
2095 foreach i
[$w.list.l curselection
] {
2096 set b
[$w.list.l get
$i]
2097 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2098 if {$check_cmt ne
{}} {
2099 if {$b eq
$check_rev} continue
2100 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2102 lappend not_merged
$b
2106 lappend to_delete
[list
$b $o]
2108 if {$not_merged ne
{}} {
2109 set msg
"The following branches are not completely merged into $check_rev:
2111 - [join $not_merged "\n - "]"
2115 -title [wm title
$w] \
2119 if {$to_delete eq
{}} return
2120 if {$delete_branch_checktype eq
{always
}} {
2121 set msg
{Recovering deleted branches is difficult.
2123 Delete the selected branches?
}
2124 if {[tk_messageBox \
2127 -title [wm title
$w] \
2129 -message $msg] ne
yes} {
2135 foreach i
$to_delete {
2138 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2139 append failed
" - $b: $err\n"
2141 set x
[lsearch
-sorted $all_heads $b]
2143 set all_heads
[lreplace
$all_heads $x $x]
2148 if {$failed ne
{}} {
2152 -title [wm title
$w] \
2154 -message "Failed to delete branches:\n$failed"
2157 set all_heads
[lsort
$all_heads]
2158 populate_branch_menu
2162 proc do_delete_branch
{} {
2163 global all_heads tracking_branches current_branch
2164 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2166 set w .branch_editor
2168 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2170 label
$w.header
-text {Delete Local Branch
} \
2172 pack
$w.header
-side top
-fill x
2175 button
$w.buttons.create
-text Delete \
2177 -command [list do_delete_branch_action
$w]
2178 pack
$w.buttons.create
-side right
2179 button
$w.buttons.cancel
-text {Cancel
} \
2181 -command [list destroy
$w]
2182 pack
$w.buttons.cancel
-side right
-padx 5
2183 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2185 labelframe
$w.list \
2186 -text {Local Branches
} \
2191 -selectmode extended \
2193 foreach h
$all_heads {
2194 if {$h ne
$current_branch} {
2195 $w.list.l insert end
$h
2198 pack
$w.list.l
-fill both
-pady 5 -padx 5
2199 pack
$w.list
-fill both
-pady 5 -padx 5
2201 labelframe
$w.validate \
2202 -text {Delete Only If
} \
2204 radiobutton
$w.validate.head_r \
2205 -text {Merged Into Local Branch
:} \
2207 -variable delete_branch_checktype \
2209 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2210 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2211 set all_trackings
[all_tracking_branches
]
2212 if {$all_trackings ne
{}} {
2213 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2214 radiobutton
$w.validate.tracking_r \
2215 -text {Merged Into Tracking Branch
:} \
2217 -variable delete_branch_checktype \
2219 eval tk_optionMenu
$w.validate.tracking_m \
2220 delete_branch_trackinghead \
2222 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2224 radiobutton
$w.validate.always_r \
2225 -text {Always
(Do not perform merge checks
)} \
2227 -variable delete_branch_checktype \
2229 grid
$w.validate.always_r
-columnspan 2 -sticky w
2230 grid columnconfigure
$w.validate
1 -weight 1
2231 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2233 set delete_branch_head
$current_branch
2234 set delete_branch_checktype
head
2236 bind $w <Visibility
> "grab $w; focus $w"
2237 bind $w <Key-Escape
> "destroy $w"
2238 wm title
$w "[appname] ([reponame]): Delete Branch"
2242 proc switch_branch
{new_branch
} {
2243 global HEAD commit_type current_branch repo_config
2245 if {![lock_index switch
]} return
2247 # -- Our in memory state should match the repository.
2249 repository_state curType curHEAD curMERGE_HEAD
2250 if {[string match amend
* $commit_type]
2251 && $curType eq
{normal
}
2252 && $curHEAD eq
$HEAD} {
2253 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2254 info_popup
{Last scanned state does not match repository state.
2256 Another Git program has modified this repository
2257 since the last scan. A rescan must be performed
2258 before the current branch can be changed.
2260 The rescan will be automatically started now.
2263 rescan
{set ui_status_value
{Ready.
}}
2267 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2268 switch_branch_stage2
{} $new_branch
2270 set ui_status_value
{Refreshing
file status...
}
2271 set cmd
[list git update-index
]
2273 lappend cmd
--unmerged
2274 lappend cmd
--ignore-missing
2275 lappend cmd
--refresh
2276 set fd_rf
[open
"| $cmd" r
]
2277 fconfigure
$fd_rf -blocking 0 -translation binary
2278 fileevent
$fd_rf readable \
2279 [list switch_branch_stage2
$fd_rf $new_branch]
2283 proc switch_branch_stage2
{fd_rf new_branch
} {
2284 global ui_status_value HEAD
2288 if {![eof
$fd_rf]} return
2292 set ui_status_value
"Updating working directory to '$new_branch'..."
2293 set cmd
[list git read-tree
]
2296 lappend cmd
--exclude-per-directory=.gitignore
2298 lappend cmd
$new_branch
2299 set fd_rt
[open
"| $cmd" r
]
2300 fconfigure
$fd_rt -blocking 0 -translation binary
2301 fileevent
$fd_rt readable \
2302 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2305 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2306 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2307 global current_branch
2308 global ui_comm ui_status_value
2310 # -- We never get interesting output on stdout; only stderr.
2313 fconfigure
$fd_rt -blocking 1
2314 if {![eof
$fd_rt]} {
2315 fconfigure
$fd_rt -blocking 0
2319 # -- The working directory wasn't in sync with the index and
2320 # we'd have to overwrite something to make the switch. A
2321 # merge is required.
2323 if {[catch
{close
$fd_rt} err
]} {
2324 regsub
{^fatal
: } $err {} err
2325 warn_popup
"File level merge required.
2329 Staying on branch '$current_branch'."
2330 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2335 # -- Update the symbolic ref. Core git doesn't even check for failure
2336 # here, it Just Works(tm). If it doesn't we are in some really ugly
2337 # state that is difficult to recover from within git-gui.
2339 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2340 error_popup
"Failed to set current branch.
2342 This working directory is only partially switched.
2343 We successfully updated your files, but failed to
2344 update an internal Git file.
2346 This should not have occurred. [appname] will now
2354 # -- Update our repository state. If we were previously in amend mode
2355 # we need to toss the current buffer and do a full rescan to update
2356 # our file lists. If we weren't in amend mode our file lists are
2357 # accurate and we can avoid the rescan.
2360 set selected_commit_type new
2361 if {[string match amend
* $commit_type]} {
2362 $ui_comm delete
0.0 end
2364 $ui_comm edit modified false
2365 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2367 repository_state commit_type HEAD MERGE_HEAD
2369 set ui_status_value
"Checked out branch '$current_branch'."
2373 ######################################################################
2375 ## remote management
2377 proc load_all_remotes
{} {
2379 global all_remotes tracking_branches
2381 set all_remotes
[list
]
2382 array
unset tracking_branches
2384 set rm_dir
[gitdir remotes
]
2385 if {[file isdirectory
$rm_dir]} {
2386 set all_remotes
[glob \
2390 -directory $rm_dir *]
2392 foreach name
$all_remotes {
2394 set fd
[open
[file join $rm_dir $name] r
]
2395 while {[gets
$fd line
] >= 0} {
2396 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2397 $line line src dst
]} continue
2398 if {![regexp ^refs
/ $dst]} {
2399 set dst
"refs/heads/$dst"
2401 set tracking_branches
($dst) [list
$name $src]
2408 foreach line
[array names repo_config remote.
*.url
] {
2409 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2410 lappend all_remotes
$name
2412 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2416 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2417 if {![regexp ^refs
/ $dst]} {
2418 set dst
"refs/heads/$dst"
2420 set tracking_branches
($dst) [list
$name $src]
2424 set all_remotes
[lsort
-unique $all_remotes]
2427 proc populate_fetch_menu
{m
} {
2428 global all_remotes repo_config
2430 foreach r
$all_remotes {
2432 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2433 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2438 set fd
[open
[gitdir remotes
$r] r
]
2439 while {[gets
$fd n
] >= 0} {
2440 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2451 -label "Fetch from $r..." \
2452 -command [list fetch_from
$r] \
2458 proc populate_push_menu
{m
} {
2459 global all_remotes repo_config
2461 foreach r
$all_remotes {
2463 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2464 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2469 set fd
[open
[gitdir remotes
$r] r
]
2470 while {[gets
$fd n
] >= 0} {
2471 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2482 -label "Push to $r..." \
2483 -command [list push_to
$r] \
2489 proc populate_pull_menu
{m
} {
2490 global repo_config all_remotes disable_on_lock
2492 foreach remote
$all_remotes {
2494 if {[array get repo_config remote.
$remote.url
] ne
{}} {
2495 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
2496 foreach line
$repo_config(remote.
$remote.fetch
) {
2497 if {[regexp
{^
([^
:]+):} $line line rb
]} {
2504 set fd
[open
[gitdir remotes
$remote] r
]
2505 while {[gets
$fd line
] >= 0} {
2506 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
2514 foreach rb
$rb_list {
2515 regsub ^refs
/heads
/ $rb {} rb_short
2517 -label "Branch $rb_short from $remote..." \
2518 -command [list pull_remote
$remote $rb] \
2520 lappend disable_on_lock \
2521 [list
$m entryconf
[$m index last
] -state]
2526 ######################################################################
2531 #define mask_width 14
2532 #define mask_height 15
2533 static unsigned char mask_bits
[] = {
2534 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2535 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2536 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2539 image create bitmap file_plain
-background white
-foreground black
-data {
2540 #define plain_width 14
2541 #define plain_height 15
2542 static unsigned char plain_bits
[] = {
2543 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2544 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2545 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2546 } -maskdata $filemask
2548 image create bitmap file_mod
-background white
-foreground blue
-data {
2549 #define mod_width 14
2550 #define mod_height 15
2551 static unsigned char mod_bits
[] = {
2552 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2553 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2554 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2555 } -maskdata $filemask
2557 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
2558 #define file_fulltick_width 14
2559 #define file_fulltick_height 15
2560 static unsigned char file_fulltick_bits
[] = {
2561 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2562 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2563 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2564 } -maskdata $filemask
2566 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
2567 #define parttick_width 14
2568 #define parttick_height 15
2569 static unsigned char parttick_bits
[] = {
2570 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2571 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2572 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2573 } -maskdata $filemask
2575 image create bitmap file_question
-background white
-foreground black
-data {
2576 #define file_question_width 14
2577 #define file_question_height 15
2578 static unsigned char file_question_bits
[] = {
2579 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2580 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2581 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2582 } -maskdata $filemask
2584 image create bitmap file_removed
-background white
-foreground red
-data {
2585 #define file_removed_width 14
2586 #define file_removed_height 15
2587 static unsigned char file_removed_bits
[] = {
2588 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2589 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2590 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2591 } -maskdata $filemask
2593 image create bitmap file_merge
-background white
-foreground blue
-data {
2594 #define file_merge_width 14
2595 #define file_merge_height 15
2596 static unsigned char file_merge_bits
[] = {
2597 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2598 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2599 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2600 } -maskdata $filemask
2602 set ui_index .vpane.files.index.list
2603 set ui_workdir .vpane.files.workdir.list
2605 set all_icons
(_
$ui_index) file_plain
2606 set all_icons
(A
$ui_index) file_fulltick
2607 set all_icons
(M
$ui_index) file_fulltick
2608 set all_icons
(D
$ui_index) file_removed
2609 set all_icons
(U
$ui_index) file_merge
2611 set all_icons
(_
$ui_workdir) file_plain
2612 set all_icons
(M
$ui_workdir) file_mod
2613 set all_icons
(D
$ui_workdir) file_question
2614 set all_icons
(U
$ui_workdir) file_merge
2615 set all_icons
(O
$ui_workdir) file_plain
2617 set max_status_desc
0
2621 {_M
"Modified, not staged"}
2622 {M_
"Staged for commit"}
2623 {MM
"Portions staged for commit"}
2624 {MD
"Staged for commit, missing"}
2626 {_O
"Untracked, not staged"}
2627 {A_
"Staged for commit"}
2628 {AM
"Portions staged for commit"}
2629 {AD
"Staged for commit, missing"}
2632 {D_
"Staged for removal"}
2633 {DO
"Staged for removal, still present"}
2635 {U_
"Requires merge resolution"}
2636 {UU
"Requires merge resolution"}
2637 {UM
"Requires merge resolution"}
2638 {UD
"Requires merge resolution"}
2640 if {$max_status_desc < [string length
[lindex
$i 1]]} {
2641 set max_status_desc
[string length
[lindex
$i 1]]
2643 set all_descs
([lindex
$i 0]) [lindex
$i 1]
2647 ######################################################################
2652 global tcl_platform tk_library
2653 if {[tk windowingsystem
] eq
{aqua
}} {
2659 proc is_Windows
{} {
2661 if {$tcl_platform(platform
) eq
{windows
}} {
2667 proc bind_button3
{w cmd
} {
2668 bind $w <Any-Button-3
> $cmd
2670 bind $w <Control-Button-1
> $cmd
2674 proc incr_font_size
{font
{amt
1}} {
2675 set sz
[font configure
$font -size]
2677 font configure
$font -size $sz
2678 font configure
${font}bold
-size $sz
2681 proc hook_failed_popup
{hook msg
} {
2686 label
$w.m.l1
-text "$hook hook failed:" \
2691 -background white
-borderwidth 1 \
2693 -width 80 -height 10 \
2695 -yscrollcommand [list
$w.m.sby
set]
2697 -text {You must correct the above errors before committing.
} \
2701 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2702 pack
$w.m.l1
-side top
-fill x
2703 pack
$w.m.l2
-side bottom
-fill x
2704 pack
$w.m.sby
-side right
-fill y
2705 pack
$w.m.t
-side left
-fill both
-expand 1
2706 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2708 $w.m.t insert
1.0 $msg
2709 $w.m.t conf
-state disabled
2711 button
$w.ok
-text OK \
2714 -command "destroy $w"
2715 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2717 bind $w <Visibility
> "grab $w; focus $w"
2718 bind $w <Key-Return
> "destroy $w"
2719 wm title
$w "[appname] ([reponame]): error"
2723 set next_console_id
0
2725 proc new_console
{short_title long_title
} {
2726 global next_console_id console_data
2727 set w .console
[incr next_console_id
]
2728 set console_data
($w) [list
$short_title $long_title]
2729 return [console_init
$w]
2732 proc console_init
{w
} {
2733 global console_cr console_data M1B
2735 set console_cr
($w) 1.0
2738 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2743 -background white
-borderwidth 1 \
2745 -width 80 -height 10 \
2748 -yscrollcommand [list
$w.m.sby
set]
2749 label
$w.m.s
-text {Working... please
wait...
} \
2753 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2754 pack
$w.m.l1
-side top
-fill x
2755 pack
$w.m.s
-side bottom
-fill x
2756 pack
$w.m.sby
-side right
-fill y
2757 pack
$w.m.t
-side left
-fill both
-expand 1
2758 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2760 menu
$w.ctxm
-tearoff 0
2761 $w.ctxm add
command -label "Copy" \
2763 -command "tk_textCopy $w.m.t"
2764 $w.ctxm add
command -label "Select All" \
2766 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2767 $w.ctxm add
command -label "Copy All" \
2770 $w.m.t tag add sel 0.0 end
2772 $w.m.t tag remove sel 0.0 end
2775 button
$w.ok
-text {Close
} \
2778 -command "destroy $w"
2779 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2781 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2782 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2783 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2784 bind $w <Visibility
> "focus $w"
2785 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2789 proc console_exec
{w cmd
{after
{}}} {
2790 # -- Windows tosses the enviroment when we exec our child.
2791 # But most users need that so we have to relogin. :-(
2794 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2797 # -- Tcl won't let us redirect both stdout and stderr to
2798 # the same pipe. So pass it through cat...
2800 set cmd
[concat |
$cmd |
& cat]
2802 set fd_f
[open
$cmd r
]
2803 fconfigure
$fd_f -blocking 0 -translation binary
2804 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2807 proc console_read
{w fd after
} {
2808 global console_cr console_data
2812 if {![winfo exists
$w]} {console_init
$w}
2813 $w.m.t conf
-state normal
2815 set n
[string length
$buf]
2817 set cr
[string first
"\r" $buf $c]
2818 set lf
[string first
"\n" $buf $c]
2819 if {$cr < 0} {set cr
[expr {$n + 1}]}
2820 if {$lf < 0} {set lf
[expr {$n + 1}]}
2823 $w.m.t insert end
[string range
$buf $c $lf]
2824 set console_cr
($w) [$w.m.t index
{end
-1c}]
2828 $w.m.t delete
$console_cr($w) end
2829 $w.m.t insert end
"\n"
2830 $w.m.t insert end
[string range
$buf $c $cr]
2835 $w.m.t conf
-state disabled
2839 fconfigure
$fd -blocking 1
2841 if {[catch
{close
$fd}]} {
2842 if {![winfo exists
$w]} {console_init
$w}
2843 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2844 $w.ok conf
-state normal
2846 } elseif
{[winfo exists
$w]} {
2847 $w.m.s conf
-background green
-text {Success
}
2848 $w.ok conf
-state normal
2851 array
unset console_cr
$w
2852 array
unset console_data
$w
2854 uplevel
#0 $after $ok
2858 fconfigure
$fd -blocking 0
2861 ######################################################################
2865 set starting_gitk_msg
{Starting gitk... please
wait...
}
2867 proc do_gitk
{revs
} {
2868 global ui_status_value starting_gitk_msg
2876 set cmd
"sh -c \"exec $cmd\""
2880 if {[catch
{eval exec $cmd} err
]} {
2881 error_popup
"Failed to start gitk:\n\n$err"
2883 set ui_status_value
$starting_gitk_msg
2885 if {$ui_status_value eq
$starting_gitk_msg} {
2886 set ui_status_value
{Ready.
}
2893 set fd
[open
"| git count-objects -v" r
]
2894 while {[gets
$fd line
] > 0} {
2895 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
2896 set stats
($name) $value
2902 foreach p
[glob
-directory [gitdir objects pack
] \
2905 incr packed_sz
[file size
$p]
2907 if {$packed_sz > 0} {
2908 set stats
(size-pack
) [expr {$packed_sz / 1024}]
2913 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2915 label
$w.header
-text {Database Statistics
} \
2917 pack
$w.header
-side top
-fill x
2919 frame
$w.buttons
-border 1
2920 button
$w.buttons.close
-text Close \
2922 -command [list destroy
$w]
2923 button
$w.buttons.gc
-text {Compress Database
} \
2925 -command "destroy $w;do_gc"
2926 pack
$w.buttons.close
-side right
2927 pack
$w.buttons.gc
-side left
2928 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2930 frame
$w.stat
-borderwidth 1 -relief solid
2932 {count
{Number of loose objects
}}
2933 {size
{Disk space used by loose objects
} { KiB
}}
2934 {in-pack
{Number of packed objects
}}
2935 {packs
{Number of packs
}}
2936 {size-pack
{Disk space used by packed objects
} { KiB
}}
2937 {prune-packable
{Packed objects waiting
for pruning
}}
2938 {garbage
{Garbage files
}}
2940 set name
[lindex
$s 0]
2941 set label
[lindex
$s 1]
2942 if {[catch
{set value
$stats($name)}]} continue
2943 if {[llength
$s] > 2} {
2944 set value
"$value[lindex $s 2]"
2947 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
2948 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
2949 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
2953 bind $w <Visibility
> "grab $w; focus $w"
2954 bind $w <Key-Escape
> [list destroy
$w]
2955 bind $w <Key-Return
> [list destroy
$w]
2956 wm title
$w "[appname] ([reponame]): Database Statistics"
2961 set w
[new_console
{gc
} {Compressing the object database
}]
2962 console_exec
$w {git gc
}
2965 proc do_fsck_objects
{} {
2966 set w
[new_console
{fsck-objects
} \
2967 {Verifying the object database with fsck-objects
}]
2968 set cmd
[list git fsck-objects
]
2971 lappend cmd
--strict
2972 console_exec
$w $cmd
2978 global ui_comm is_quitting repo_config commit_type
2980 if {$is_quitting} return
2983 # -- Stash our current commit buffer.
2985 set save
[gitdir GITGUI_MSG
]
2986 set msg
[string trim
[$ui_comm get
0.0 end
]]
2987 if {![string match amend
* $commit_type]
2988 && [$ui_comm edit modified
]
2991 set fd
[open
$save w
]
2992 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2996 catch
{file delete
$save}
2999 # -- Stash our current window geometry into this repository.
3001 set cfg_geometry
[list
]
3002 lappend cfg_geometry
[wm geometry .
]
3003 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
3004 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
3005 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
3008 if {$cfg_geometry ne
$rc_geometry} {
3009 catch
{exec git repo-config gui.geometry
$cfg_geometry}
3016 rescan
{set ui_status_value
{Ready.
}}
3019 proc unstage_helper
{txt paths
} {
3020 global file_states current_diff_path
3022 if {![lock_index begin-update
]} return
3026 foreach path
$paths {
3027 switch
-glob -- [lindex
$file_states($path) 0] {
3031 lappend pathList
$path
3032 if {$path eq
$current_diff_path} {
3033 set after
{reshow_diff
;}
3038 if {$pathList eq
{}} {
3044 [concat
$after {set ui_status_value
{Ready.
}}]
3048 proc do_unstage_selection
{} {
3049 global current_diff_path selected_paths
3051 if {[array size selected_paths
] > 0} {
3053 {Unstaging selected files from commit
} \
3054 [array names selected_paths
]
3055 } elseif
{$current_diff_path ne
{}} {
3057 "Unstaging [short_path $current_diff_path] from commit" \
3058 [list
$current_diff_path]
3062 proc add_helper
{txt paths
} {
3063 global file_states current_diff_path
3065 if {![lock_index begin-update
]} return
3069 foreach path
$paths {
3070 switch
-glob -- [lindex
$file_states($path) 0] {
3075 lappend pathList
$path
3076 if {$path eq
$current_diff_path} {
3077 set after
{reshow_diff
;}
3082 if {$pathList eq
{}} {
3088 [concat
$after {set ui_status_value
{Ready to commit.
}}]
3092 proc do_add_selection
{} {
3093 global current_diff_path selected_paths
3095 if {[array size selected_paths
] > 0} {
3097 {Adding selected files
} \
3098 [array names selected_paths
]
3099 } elseif
{$current_diff_path ne
{}} {
3101 "Adding [short_path $current_diff_path]" \
3102 [list
$current_diff_path]
3106 proc do_add_all
{} {
3110 foreach path
[array names file_states
] {
3111 switch
-glob -- [lindex
$file_states($path) 0] {
3114 ?D
{lappend paths
$path}
3117 add_helper
{Adding all changed files
} $paths
3120 proc revert_helper
{txt paths
} {
3121 global file_states current_diff_path
3123 if {![lock_index begin-update
]} return
3127 foreach path
$paths {
3128 switch
-glob -- [lindex
$file_states($path) 0] {
3132 lappend pathList
$path
3133 if {$path eq
$current_diff_path} {
3134 set after
{reshow_diff
;}
3140 set n
[llength
$pathList]
3144 } elseif
{$n == 1} {
3145 set s
"[short_path [lindex $pathList]]"
3147 set s
"these $n files"
3150 set reply
[tk_dialog \
3152 "[appname] ([reponame])" \
3153 "Revert changes in $s?
3155 Any unadded changes will be permanently lost by the revert." \
3165 [concat
$after {set ui_status_value
{Ready.
}}]
3171 proc do_revert_selection
{} {
3172 global current_diff_path selected_paths
3174 if {[array size selected_paths
] > 0} {
3176 {Reverting selected files
} \
3177 [array names selected_paths
]
3178 } elseif
{$current_diff_path ne
{}} {
3180 "Reverting [short_path $current_diff_path]" \
3181 [list
$current_diff_path]
3185 proc do_signoff
{} {
3188 set me
[committer_ident
]
3189 if {$me eq
{}} return
3191 set sob
"Signed-off-by: $me"
3192 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
3193 if {$last ne
$sob} {
3194 $ui_comm edit separator
3196 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
3197 $ui_comm insert end
"\n"
3199 $ui_comm insert end
"\n$sob"
3200 $ui_comm edit separator
3205 proc do_select_commit_type
{} {
3206 global commit_type selected_commit_type
3208 if {$selected_commit_type eq
{new
}
3209 && [string match amend
* $commit_type]} {
3211 } elseif
{$selected_commit_type eq
{amend
}
3212 && ![string match amend
* $commit_type]} {
3215 # The amend request was rejected...
3217 if {![string match amend
* $commit_type]} {
3218 set selected_commit_type new
3228 global appvers copyright
3229 global tcl_patchLevel tk_patchLevel
3233 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3235 label
$w.header
-text "About [appname]" \
3237 pack
$w.header
-side top
-fill x
3240 button
$w.buttons.close
-text {Close
} \
3242 -command [list destroy
$w]
3243 pack
$w.buttons.close
-side right
3244 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3247 -text "[appname] - a commit creation tool for Git.
3255 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
3258 append v
"[appname] version $appvers\n"
3259 append v
"[exec git version]\n"
3261 if {$tcl_patchLevel eq
$tk_patchLevel} {
3262 append v
"Tcl/Tk version $tcl_patchLevel"
3264 append v
"Tcl version $tcl_patchLevel"
3265 append v
", Tk version $tk_patchLevel"
3276 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
3278 menu
$w.ctxm
-tearoff 0
3279 $w.ctxm add
command \
3284 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3287 bind $w <Visibility
> "grab $w; focus $w"
3288 bind $w <Key-Escape
> "destroy $w"
3289 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3290 wm title
$w "About [appname]"
3294 proc do_options
{} {
3295 global repo_config global_config font_descs
3296 global repo_config_new global_config_new
3298 array
unset repo_config_new
3299 array
unset global_config_new
3300 foreach name
[array names repo_config
] {
3301 set repo_config_new
($name) $repo_config($name)
3304 foreach name
[array names repo_config
] {
3306 gui.diffcontext
{continue}
3308 set repo_config_new
($name) $repo_config($name)
3310 foreach name
[array names global_config
] {
3311 set global_config_new
($name) $global_config($name)
3314 set w .options_editor
3316 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3318 label
$w.header
-text "[appname] Options" \
3320 pack
$w.header
-side top
-fill x
3323 button
$w.buttons.restore
-text {Restore Defaults
} \
3325 -command do_restore_defaults
3326 pack
$w.buttons.restore
-side left
3327 button
$w.buttons.save
-text Save \
3330 catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3333 pack
$w.buttons.save
-side right
3334 button
$w.buttons.cancel
-text {Cancel
} \
3336 -command [list destroy
$w]
3337 pack
$w.buttons.cancel
-side right
-padx 5
3338 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3340 labelframe
$w.repo
-text "[reponame] Repository" \
3342 labelframe
$w.global
-text {Global
(All Repositories
)} \
3344 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
3345 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
3348 {b pullsummary
{Show Pull Summary
}}
3349 {b trustmtime
{Trust File Modification Timestamps
}}
3350 {i diffcontext
{Number of Diff Context Lines
}}
3351 {t newbranchtemplate
{New Branch Name Template
}}
3353 set type [lindex
$option 0]
3354 set name
[lindex
$option 1]
3355 set text
[lindex
$option 2]
3356 foreach f
{repo global
} {
3359 checkbutton
$w.
$f.
$name -text $text \
3360 -variable ${f}_config_new
(gui.
$name) \
3364 pack
$w.
$f.
$name -side top
-anchor w
3368 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3369 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
3370 spinbox
$w.
$f.
$name.v \
3371 -textvariable ${f}_config_new
(gui.
$name) \
3372 -from 1 -to 99 -increment 1 \
3375 bind $w.
$f.
$name.v
<FocusIn
> {%W selection range
0 end
}
3376 pack
$w.
$f.
$name.v
-side right
-anchor e
-padx 5
3377 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3381 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3382 text
$w.
$f.
$name.v \
3388 $w.
$f.
$name.v insert
0.0 [set ${f}_config_new
(gui.
$name)]
3389 bind $w.
$f.
$name.v
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
3390 bind $w.
$f.
$name.v
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
3391 bind $w.
$f.
$name.v
<Key-Return
> break
3392 bind $w.
$f.
$name.v
<FocusIn
> "$w.$f.$name.v tag add sel 0.0 end"
3393 bind $w.
$f.
$name.v
<FocusOut
> "
3394 set ${f}_config_new(gui.$name) \
3395 \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3397 pack
$w.
$f.
$name.l
-side left
-anchor w
3398 pack
$w.
$f.
$name.v
-side left
-anchor w \
3401 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3407 set all_fonts
[lsort
[font families
]]
3408 foreach option
$font_descs {
3409 set name
[lindex
$option 0]
3410 set font
[lindex
$option 1]
3411 set text
[lindex
$option 2]
3413 set global_config_new
(gui.
$font^^family
) \
3414 [font configure
$font -family]
3415 set global_config_new
(gui.
$font^^size
) \
3416 [font configure
$font -size]
3418 frame
$w.global.
$name
3419 label
$w.global.
$name.l
-text "$text:" -font font_ui
3420 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
3421 eval tk_optionMenu
$w.global.
$name.family \
3422 global_config_new
(gui.
$font^^family
) \
3424 spinbox
$w.global.
$name.size \
3425 -textvariable global_config_new
(gui.
$font^^size
) \
3426 -from 2 -to 80 -increment 1 \
3429 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
3430 pack
$w.global.
$name.size
-side right
-anchor e
3431 pack
$w.global.
$name.family
-side right
-anchor e
3432 pack
$w.global.
$name -side top
-anchor w
-fill x
3435 bind $w <Visibility
> "grab $w; focus $w"
3436 bind $w <Key-Escape
> "destroy $w"
3437 wm title
$w "[appname] ([reponame]): Options"
3441 proc do_restore_defaults
{} {
3442 global font_descs default_config repo_config
3443 global repo_config_new global_config_new
3445 foreach name
[array names default_config
] {
3446 set repo_config_new
($name) $default_config($name)
3447 set global_config_new
($name) $default_config($name)
3450 foreach option
$font_descs {
3451 set name
[lindex
$option 0]
3452 set repo_config
(gui.
$name) $default_config(gui.
$name)
3456 foreach option
$font_descs {
3457 set name
[lindex
$option 0]
3458 set font
[lindex
$option 1]
3459 set global_config_new
(gui.
$font^^family
) \
3460 [font configure
$font -family]
3461 set global_config_new
(gui.
$font^^size
) \
3462 [font configure
$font -size]
3466 proc do_save_config
{w
} {
3467 if {[catch
{save_config
} err
]} {
3468 error_popup
"Failed to completely save options:\n\n$err"
3474 proc do_windows_shortcut
{} {
3478 set desktop
[exec cygpath \
3486 set fn
[tk_getSaveFile \
3488 -title "[appname] ([reponame]): Create Desktop Icon" \
3489 -initialdir $desktop \
3490 -initialfile "Git [reponame].bat"]
3494 set sh
[exec cygpath \
3498 set me
[exec cygpath \
3502 set gd
[exec cygpath \
3506 set gw
[exec cygpath \
3509 [file dirname [gitdir
]]]
3510 regsub
-all ' $me "'\\''" me
3511 regsub -all ' $gd "'\\''" gd
3512 puts $fd "@ECHO Entering $gw"
3513 puts $fd "@ECHO Starting git-gui... please wait..."
3514 puts -nonewline $fd "@\"$sh\" --login -c \""
3515 puts -nonewline $fd "GIT_DIR='$gd'"
3516 puts -nonewline $fd " '$me'"
3520 error_popup "Cannot write script:\n\n$err"
3525 proc do_macosx_app {} {
3528 set fn [tk_getSaveFile \
3530 -title "[appname] ([reponame]): Create Desktop Icon" \
3531 -initialdir [file join $env(HOME) Desktop] \
3532 -initialfile "Git [reponame].app"]
3535 set Contents [file join $fn Contents]
3536 set MacOS [file join $Contents MacOS]
3537 set exe [file join $MacOS git-gui]
3541 set fd [open [file join $Contents Info.plist] w]
3542 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3543 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3544 <plist version="1.0">
3546 <key>CFBundleDevelopmentRegion</key>
3547 <string>English</string>
3548 <key>CFBundleExecutable</key>
3549 <string>git-gui</string>
3550 <key>CFBundleIdentifier</key>
3551 <string>org.spearce.git-gui</string>
3552 <key>CFBundleInfoDictionaryVersion</key>
3553 <string>6.0</string>
3554 <key>CFBundlePackageType</key>
3555 <string>APPL</string>
3556 <key>CFBundleSignature</key>
3557 <string>????</string>
3558 <key>CFBundleVersion</key>
3559 <string>1.0</string>
3560 <key>NSPrincipalClass</key>
3561 <string>NSApplication</string>
3566 set fd [open $exe w]
3567 set gd [file normalize [gitdir]]
3568 set ep [file normalize [exec git --exec-path]]
3569 regsub -all ' $gd "'\\''" gd
3570 regsub
-all ' $ep "'\\''" ep
3571 puts $fd "#!/bin/sh"
3572 foreach name
[array names env
] {
3573 if {[string match GIT_
* $name]} {
3574 regsub
-all ' $env($name) "'\\''" v
3575 puts $fd "export $name='$v'"
3578 puts $fd "export PATH
='$ep':\
$PATH"
3579 puts $fd "export GIT_DIR
='$gd'"
3580 puts $fd "exec [file normalize
$argv0]"
3583 file attributes $exe -permissions u+x,g+x,o+x
3585 error_popup "Cannot
write icon
:\n\n$err"
3590 proc toggle_or_diff {w x y} {
3591 global file_states file_lists current_diff_path ui_index ui_workdir
3592 global last_clicked selected_paths
3594 set pos [split [$w index @$x,$y] .]
3595 set lno [lindex $pos 0]
3596 set col [lindex $pos 1]
3597 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3603 set last_clicked [list $w $lno]
3604 array unset selected_paths
3605 $ui_index tag remove in_sel 0.0 end
3606 $ui_workdir tag remove in_sel 0.0 end
3609 if {$current_diff_path eq $path} {
3610 set after {reshow_diff;}
3614 if {$w eq $ui_index} {
3616 "Unstaging
[short_path
$path] from commit
" \
3618 [concat $after {set ui_status_value {Ready.}}]
3619 } elseif {$w eq $ui_workdir} {
3621 "Adding
[short_path
$path]" \
3623 [concat $after {set ui_status_value {Ready.}}]
3626 show_diff $path $w $lno
3630 proc add_one_to_selection {w x y} {
3631 global file_lists last_clicked selected_paths
3633 set lno [lindex [split [$w index @$x,$y] .] 0]
3634 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3640 if {$last_clicked ne {}
3641 && [lindex $last_clicked 0] ne $w} {
3642 array unset selected_paths
3643 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3646 set last_clicked [list $w $lno]
3647 if {[catch {set in_sel $selected_paths($path)}]} {
3651 unset selected_paths($path)
3652 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3654 set selected_paths($path) 1
3655 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3659 proc add_range_to_selection {w x y} {
3660 global file_lists last_clicked selected_paths
3662 if {[lindex $last_clicked 0] ne $w} {
3663 toggle_or_diff $w $x $y
3667 set lno [lindex [split [$w index @$x,$y] .] 0]
3668 set lc [lindex $last_clicked 1]
3677 foreach path [lrange $file_lists($w) \
3678 [expr {$begin - 1}] \
3679 [expr {$end - 1}]] {
3680 set selected_paths($path) 1
3682 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3685 ######################################################################
3689 set cursor_ptr arrow
3690 font create font_diff -family Courier -size 10
3694 eval font configure font_ui [font actual [.dummy cget -font]]
3698 font create font_uibold
3699 font create font_diffbold
3704 } elseif {[is_MacOSX]} {
3712 proc apply_config {} {
3713 global repo_config font_descs
3715 foreach option $font_descs {
3716 set name [lindex $option 0]
3717 set font [lindex $option 1]
3719 foreach {cn cv} $repo_config(gui.$name) {
3720 font configure $font $cn $cv
3723 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
3725 foreach {cn cv} [font configure $font] {
3726 font configure ${font}bold $cn $cv
3728 font configure ${font}bold -weight bold
3732 set default_config(gui.trustmtime) false
3733 set default_config(gui.pullsummary) true
3734 set default_config(gui.diffcontext) 5
3735 set default_config(gui.newbranchtemplate) {}
3736 set default_config(gui.fontui) [font configure font_ui]
3737 set default_config(gui.fontdiff) [font configure font_diff]
3739 {fontui font_ui {Main Font}}
3740 {fontdiff font_diff {Diff/Console Font}}
3745 ######################################################################
3751 menu .mbar -tearoff 0
3752 .mbar add cascade -label Repository -menu .mbar.repository
3753 .mbar add cascade -label Edit -menu .mbar.edit
3754 if {!$single_commit} {
3755 .mbar add cascade -label Branch -menu .mbar.branch
3757 .mbar add cascade -label Commit -menu .mbar.commit
3758 if {!$single_commit} {
3759 .mbar add cascade -label Fetch -menu .mbar.fetch
3760 .mbar add cascade -label Pull -menu .mbar.pull
3761 .mbar add cascade -label Push -menu .mbar.push
3763 . configure -menu .mbar
3765 # -- Repository Menu
3767 menu .mbar.repository
3768 .mbar.repository add command \
3769 -label {Visualize Current Branch} \
3770 -command {do_gitk {}} \
3773 .mbar.repository add command \
3774 -label {Visualize All Branches} \
3775 -command {do_gitk {--all}} \
3778 .mbar.repository add separator
3780 if {!$single_commit} {
3781 .mbar.repository add command -label {Database Statistics} \
3785 .mbar.repository add command -label {Compress Database} \
3789 .mbar.repository add command -label {Verify Database} \
3790 -command do_fsck_objects \
3793 .mbar.repository add separator
3796 .mbar.repository add command \
3797 -label {Create Desktop Icon} \
3798 -command do_windows_shortcut \
3800 } elseif {[is_MacOSX]} {
3801 .mbar.repository add command \
3802 -label {Create Desktop Icon} \
3803 -command do_macosx_app \
3808 .mbar.repository add command -label Quit \
3810 -accelerator $M1T-Q \
3816 .mbar.edit add command -label Undo \
3817 -command {catch {[focus] edit undo}} \
3818 -accelerator $M1T-Z \
3820 .mbar.edit add command -label Redo \
3821 -command {catch {[focus] edit redo}} \
3822 -accelerator $M1T-Y \
3824 .mbar.edit add separator
3825 .mbar.edit add command -label Cut \
3826 -command {catch {tk_textCut [focus]}} \
3827 -accelerator $M1T-X \
3829 .mbar.edit add command -label Copy \
3830 -command {catch {tk_textCopy [focus]}} \
3831 -accelerator $M1T-C \
3833 .mbar.edit add command -label Paste \
3834 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3835 -accelerator $M1T-V \
3837 .mbar.edit add command -label Delete \
3838 -command {catch {[focus] delete sel.first sel.last}} \
3841 .mbar.edit add separator
3842 .mbar.edit add command -label {Select All} \
3843 -command {catch {[focus] tag add sel 0.0 end}} \
3844 -accelerator $M1T-A \
3849 if {!$single_commit} {
3852 .mbar.branch add command -label {Create...} \
3853 -command do_create_branch \
3854 -accelerator $M1T-N \
3856 lappend disable_on_lock [list .mbar.branch entryconf \
3857 [.mbar.branch index last] -state]
3859 .mbar.branch add command -label {Delete...} \
3860 -command do_delete_branch \
3862 lappend disable_on_lock [list .mbar.branch entryconf \
3863 [.mbar.branch index last] -state]
3870 .mbar.commit add radiobutton \
3871 -label {New Commit} \
3872 -command do_select_commit_type \
3873 -variable selected_commit_type \
3876 lappend disable_on_lock \
3877 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3879 .mbar.commit add radiobutton \
3880 -label {Amend Last Commit} \
3881 -command do_select_commit_type \
3882 -variable selected_commit_type \
3885 lappend disable_on_lock \
3886 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3888 .mbar.commit add separator
3890 .mbar.commit add command -label Rescan \
3891 -command do_rescan \
3894 lappend disable_on_lock \
3895 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3897 .mbar.commit add command -label {Add To Commit} \
3898 -command do_add_selection \
3900 lappend disable_on_lock \
3901 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3903 .mbar.commit add command -label {Add All To Commit} \
3904 -command do_add_all \
3905 -accelerator $M1T-I \
3907 lappend disable_on_lock \
3908 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3910 .mbar.commit add command -label {Unstage From Commit} \
3911 -command do_unstage_selection \
3913 lappend disable_on_lock \
3914 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3916 .mbar.commit add command -label {Revert Changes} \
3917 -command do_revert_selection \
3919 lappend disable_on_lock \
3920 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3922 .mbar.commit add separator
3924 .mbar.commit add command -label {Sign Off} \
3925 -command do_signoff \
3926 -accelerator $M1T-S \
3929 .mbar.commit add command -label Commit \
3930 -command do_commit \
3931 -accelerator $M1T-Return \
3933 lappend disable_on_lock \
3934 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3936 # -- Transport menus
3938 if {!$single_commit} {
3945 # -- Apple Menu (Mac OS X only)
3947 .mbar add cascade -label Apple -menu .mbar.apple
3950 .mbar.apple add command -label "About
[appname
]" \
3953 .mbar.apple add command -label "[appname
] Options...
" \
3954 -command do_options \
3959 .mbar.edit add separator
3960 .mbar.edit add command -label {Options...} \
3961 -command do_options \
3966 if {[file exists /usr/local/miga/lib/gui-miga]
3967 && [file exists .pvcsrc]} {
3969 global ui_status_value
3970 if {![lock_index update]} return
3971 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3972 set miga_fd [open "|
$cmd" r]
3973 fconfigure $miga_fd -blocking 0
3974 fileevent $miga_fd readable [list miga_done $miga_fd]
3975 set ui_status_value {Running miga...}
3977 proc miga_done {fd} {
3982 rescan [list set ui_status_value {Ready.}]
3985 .mbar add cascade -label Tools -menu .mbar.tools
3987 .mbar.tools add command -label "Migrate
" \
3990 lappend disable_on_lock \
3991 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3996 .mbar add cascade -label Help -menu .mbar.help
3999 .mbar.help add command -label "About
[appname
]" \
4011 -text {Current Branch:} \
4016 -textvariable current_branch \
4020 pack .branch.l1 -side left
4021 pack .branch.cb -side left -fill x
4022 pack .branch -side top -fill x
4024 # -- Main Window Layout
4026 panedwindow .vpane -orient vertical
4027 panedwindow .vpane.files -orient horizontal
4028 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4029 pack .vpane -anchor n -side top -fill both -expand 1
4031 # -- Index File List
4033 frame .vpane.files.index -height 100 -width 200
4034 label .vpane.files.index.title -text {Changes To Be Committed} \
4037 text $ui_index -background white -borderwidth 0 \
4038 -width 20 -height 10 \
4041 -cursor $cursor_ptr \
4042 -xscrollcommand {.vpane.files.index.sx set} \
4043 -yscrollcommand {.vpane.files.index.sy set} \
4045 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4046 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4047 pack .vpane.files.index.title -side top -fill x
4048 pack .vpane.files.index.sx -side bottom -fill x
4049 pack .vpane.files.index.sy -side right -fill y
4050 pack $ui_index -side left -fill both -expand 1
4051 .vpane.files add .vpane.files.index -sticky nsew
4053 # -- Working Directory File List
4055 frame .vpane.files.workdir -height 100 -width 200
4056 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4059 text $ui_workdir -background white -borderwidth 0 \
4060 -width 20 -height 10 \
4063 -cursor $cursor_ptr \
4064 -xscrollcommand {.vpane.files.workdir.sx set} \
4065 -yscrollcommand {.vpane.files.workdir.sy set} \
4067 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4068 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4069 pack .vpane.files.workdir.title -side top -fill x
4070 pack .vpane.files.workdir.sx -side bottom -fill x
4071 pack .vpane.files.workdir.sy -side right -fill y
4072 pack $ui_workdir -side left -fill both -expand 1
4073 .vpane.files add .vpane.files.workdir -sticky nsew
4075 foreach i [list $ui_index $ui_workdir] {
4076 $i tag conf in_diff -font font_uibold
4077 $i tag conf in_sel \
4078 -background [$i cget -foreground] \
4079 -foreground [$i cget -background]
4083 # -- Diff and Commit Area
4085 frame .vpane.lower -height 300 -width 400
4086 frame .vpane.lower.commarea
4087 frame .vpane.lower.diff -relief sunken -borderwidth 1
4088 pack .vpane.lower.commarea -side top -fill x
4089 pack .vpane.lower.diff -side bottom -fill both -expand 1
4090 .vpane add .vpane.lower -sticky nsew
4092 # -- Commit Area Buttons
4094 frame .vpane.lower.commarea.buttons
4095 label .vpane.lower.commarea.buttons.l -text {} \
4099 pack .vpane.lower.commarea.buttons.l -side top -fill x
4100 pack .vpane.lower.commarea.buttons -side left -fill y
4102 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4103 -command do_rescan \
4105 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4106 lappend disable_on_lock \
4107 {.vpane.lower.commarea.buttons.rescan conf -state}
4109 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4110 -command do_add_all \
4112 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4113 lappend disable_on_lock \
4114 {.vpane.lower.commarea.buttons.incall conf -state}
4116 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4117 -command do_signoff \
4119 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4121 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4122 -command do_commit \
4124 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4125 lappend disable_on_lock \
4126 {.vpane.lower.commarea.buttons.commit conf -state}
4128 # -- Commit Message Buffer
4130 frame .vpane.lower.commarea.buffer
4131 frame .vpane.lower.commarea.buffer.header
4132 set ui_comm .vpane.lower.commarea.buffer.t
4133 set ui_coml .vpane.lower.commarea.buffer.header.l
4134 radiobutton .vpane.lower.commarea.buffer.header.new \
4135 -text {New Commit} \
4136 -command do_select_commit_type \
4137 -variable selected_commit_type \
4140 lappend disable_on_lock \
4141 [list .vpane.lower.commarea.buffer.header.new conf -state]
4142 radiobutton .vpane.lower.commarea.buffer.header.amend \
4143 -text {Amend Last Commit} \
4144 -command do_select_commit_type \
4145 -variable selected_commit_type \
4148 lappend disable_on_lock \
4149 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4154 proc trace_commit_type {varname args} {
4155 global ui_coml commit_type
4156 switch -glob -- $commit_type {
4157 initial {set txt {Initial Commit Message:}}
4158 amend {set txt {Amended Commit Message:}}
4159 amend-initial {set txt {Amended Initial Commit Message:}}
4160 amend-merge {set txt {Amended Merge Commit Message:}}
4161 merge {set txt {Merge Commit Message:}}
4162 * {set txt {Commit Message:}}
4164 $ui_coml conf -text $txt
4166 trace add variable commit_type write trace_commit_type
4167 pack $ui_coml -side left -fill x
4168 pack .vpane.lower.commarea.buffer.header.amend -side right
4169 pack .vpane.lower.commarea.buffer.header.new -side right
4171 text $ui_comm -background white -borderwidth 1 \
4174 -autoseparators true \
4176 -width 75 -height 9 -wrap none \
4178 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4179 scrollbar .vpane.lower.commarea.buffer.sby \
4180 -command [list $ui_comm yview]
4181 pack .vpane.lower.commarea.buffer.header -side top -fill x
4182 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4183 pack $ui_comm -side left -fill y
4184 pack .vpane.lower.commarea.buffer -side left -fill y
4186 # -- Commit Message Buffer Context Menu
4188 set ctxm .vpane.lower.commarea.buffer.ctxm
4189 menu $ctxm -tearoff 0
4193 -command {tk_textCut $ui_comm}
4197 -command {tk_textCopy $ui_comm}
4201 -command {tk_textPaste $ui_comm}
4205 -command {$ui_comm delete sel.first sel.last}
4208 -label {Select All} \
4210 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4215 $ui_comm tag add sel 0.0 end
4216 tk_textCopy $ui_comm
4217 $ui_comm tag remove sel 0.0 end
4224 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
4228 set current_diff_path {}
4229 set current_diff_side {}
4230 set diff_actions [list]
4231 proc trace_current_diff_path {varname args} {
4232 global current_diff_path diff_actions file_states
4233 if {$current_diff_path eq {}} {
4239 set p $current_diff_path
4240 set s [mapdesc [lindex $file_states($p) 0] $p]
4242 set p [escape_path $p]
4246 .vpane.lower.diff.header.status configure -text $s
4247 .vpane.lower.diff.header.file configure -text $f
4248 .vpane.lower.diff.header.path configure -text $p
4249 foreach w $diff_actions {
4253 trace add variable current_diff_path write trace_current_diff_path
4255 frame .vpane.lower.diff.header -background orange
4256 label .vpane.lower.diff.header.status \
4257 -background orange \
4258 -width $max_status_desc \
4262 label .vpane.lower.diff.header.file \
4263 -background orange \
4267 label .vpane.lower.diff.header.path \
4268 -background orange \
4272 pack .vpane.lower.diff.header.status -side left
4273 pack .vpane.lower.diff.header.file -side left
4274 pack .vpane.lower.diff.header.path -fill x
4275 set ctxm .vpane.lower.diff.header.ctxm
4276 menu $ctxm -tearoff 0
4285 -- $current_diff_path
4287 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4288 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
4292 frame .vpane.lower.diff.body
4293 set ui_diff .vpane.lower.diff.body.t
4294 text $ui_diff -background white -borderwidth 0 \
4295 -width 80 -height 15 -wrap none \
4297 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4298 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4300 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4301 -command [list $ui_diff xview]
4302 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4303 -command [list $ui_diff yview]
4304 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4305 pack .vpane.lower.diff.body.sby -side right -fill y
4306 pack $ui_diff -side left -fill both -expand 1
4307 pack .vpane.lower.diff.header -side top -fill x
4308 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4310 $ui_diff tag conf d_cr -elide true
4311 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4312 $ui_diff tag conf d_+ -foreground {#00a000}
4313 $ui_diff tag conf d_- -foreground red
4315 $ui_diff tag conf d_++ -foreground {#00a000}
4316 $ui_diff tag conf d_-- -foreground red
4317 $ui_diff tag conf d_+s \
4318 -foreground {#00a000} \
4319 -background {#e2effa}
4320 $ui_diff tag conf d_-s \
4322 -background {#e2effa}
4323 $ui_diff tag conf d_s+ \
4324 -foreground {#00a000} \
4326 $ui_diff tag conf d_s- \
4330 $ui_diff tag conf d<<<<<<< \
4331 -foreground orange \
4333 $ui_diff tag conf d======= \
4334 -foreground orange \
4336 $ui_diff tag conf d>>>>>>> \
4337 -foreground orange \
4340 $ui_diff tag raise sel
4342 # -- Diff Body Context Menu
4344 set ctxm .vpane.lower.diff.body.ctxm
4345 menu $ctxm -tearoff 0
4349 -command reshow_diff
4350 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4354 -command {tk_textCopy $ui_diff}
4355 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4357 -label {Select All} \
4359 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4360 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4365 $ui_diff tag add sel 0.0 end
4366 tk_textCopy $ui_diff
4367 $ui_diff tag remove sel 0.0 end
4369 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4372 -label {Apply/Reverse Hunk} \
4374 -command {apply_hunk $cursorX $cursorY}
4375 set ui_diff_applyhunk [$ctxm index last]
4376 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4379 -label {Decrease Font Size} \
4381 -command {incr_font_size font_diff -1}
4382 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4384 -label {Increase Font Size} \
4386 -command {incr_font_size font_diff 1}
4387 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4390 -label {Show Less Context} \
4392 -command {if {$repo_config(gui.diffcontext) >= 2} {
4393 incr repo_config(gui.diffcontext) -1
4396 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4398 -label {Show More Context} \
4401 incr repo_config(gui.diffcontext)
4404 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4406 $ctxm add command -label {Options...} \
4409 bind_button3 $ui_diff "
4412 if {\
$ui_index eq \
$current_diff_side} {
4413 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
4415 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
4417 tk_popup
$ctxm %X
%Y
4422 set ui_status_value {Initializing...}
4423 label .status -textvariable ui_status_value \
4429 pack .status -anchor w -side bottom -fill x
4434 set gm $repo_config(gui.geometry)
4435 wm geometry . [lindex $gm 0]
4436 .vpane sash place 0 \
4437 [lindex [.vpane sash coord 0] 0] \
4439 .vpane.files sash place 0 \
4441 [lindex [.vpane.files sash coord 0] 1]
4447 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4448 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4449 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4450 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4451 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4452 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4453 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4454 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4455 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4456 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4457 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4459 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4460 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4461 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4462 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4463 bind $ui_diff <$M1B-Key-v> {break}
4464 bind $ui_diff <$M1B-Key-V> {break}
4465 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4466 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4467 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4468 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4469 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4470 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4472 if {!$single_commit} {
4473 bind . <$M1B-Key-n> do_create_branch
4474 bind . <$M1B-Key-N> do_create_branch
4477 bind . <Destroy> do_quit
4478 bind all <Key-F5> do_rescan
4479 bind all <$M1B-Key-r> do_rescan
4480 bind all <$M1B-Key-R> do_rescan
4481 bind . <$M1B-Key-s> do_signoff
4482 bind . <$M1B-Key-S> do_signoff
4483 bind . <$M1B-Key-i> do_add_all
4484 bind . <$M1B-Key-I> do_add_all
4485 bind . <$M1B-Key-Return> do_commit
4486 bind all <$M1B-Key-q> do_quit
4487 bind all <$M1B-Key-Q> do_quit
4488 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4489 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4490 foreach i [list $ui_index $ui_workdir] {
4491 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
4492 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
4493 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
4497 set file_lists($ui_index) [list]
4498 set file_lists($ui_workdir) [list]
4502 set MERGE_HEAD [list]
4505 set current_branch {}
4506 set current_diff_path {}
4507 set selected_commit_type new
4509 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
4510 focus -force $ui_comm
4512 # -- Warn the user about environmental problems. Cygwin's Tcl
4513 # does *not* pass its env array onto any processes it spawns.
4514 # This means that git processes get none of our environment.
4519 set msg "Possible environment issues exist.
4521 The following environment variables are probably
4522 going to be ignored by any Git subprocess run
4526 foreach name [array names env] {
4527 switch -regexp -- $name {
4528 {^GIT_INDEX_FILE$} -
4529 {^GIT_OBJECT_DIRECTORY$} -
4530 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4532 {^GIT_EXTERNAL_DIFF$} -
4536 {^GIT_CONFIG_LOCAL$} -
4537 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4538 append msg " - $name\n"
4541 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4542 append msg " - $name\n"
4544 set suggest_user $name
4548 if {$ignored_env > 0} {
4550 This is due to a known issue with the
4551 Tcl binary distributed by Cygwin.
"
4553 if {$suggest_user ne {}} {
4556 A good replacement
for $suggest_user
4557 is placing values
for the user.name and
4558 user.email settings into your personal
4564 unset ignored_env msg suggest_user name
4567 # -- Only initialize complex UI if we are going to stay running.
4569 if {!$single_commit} {
4573 populate_branch_menu
4574 populate_fetch_menu .mbar.fetch
4575 populate_pull_menu .mbar.pull
4576 populate_push_menu .mbar.push
4579 # -- Only suggest a gc run if we are going to stay running.
4581 if {!$single_commit} {
4582 set object_limit 2000
4583 if {[is_Windows]} {set object_limit 200}
4584 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4585 if {$objects_current >= $object_limit} {
4587 "This repository currently has
$objects_current loose objects.
4589 To maintain optimal performance it is strongly
4590 recommended that you
compress the database
4591 when
more than
$object_limit loose objects exist.
4593 Compress the database now?
"] eq yes} {
4597 unset object_limit _junk objects_current
4600 lock_index begin-read