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 regsub
-all -line {[ \r\t]+$
} $content {} content
432 $ui_comm delete
0.0 end
433 $ui_comm insert end
$content
439 proc read_diff_index
{fd after
} {
442 append buf_rdi
[read $fd]
444 set n
[string length
$buf_rdi]
446 set z1
[string first
"\0" $buf_rdi $c]
449 set z2
[string first
"\0" $buf_rdi $z1]
453 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
454 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
456 [encoding convertfrom
$p] \
458 [list
[lindex
$i 0] [lindex
$i 2]] \
464 set buf_rdi
[string range
$buf_rdi $c end
]
469 rescan_done
$fd buf_rdi
$after
472 proc read_diff_files
{fd after
} {
475 append buf_rdf
[read $fd]
477 set n
[string length
$buf_rdf]
479 set z1
[string first
"\0" $buf_rdf $c]
482 set z2
[string first
"\0" $buf_rdf $z1]
486 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
487 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
489 [encoding convertfrom
$p] \
492 [list
[lindex
$i 0] [lindex
$i 2]]
497 set buf_rdf
[string range
$buf_rdf $c end
]
502 rescan_done
$fd buf_rdf
$after
505 proc read_ls_others
{fd after
} {
508 append buf_rlo
[read $fd]
509 set pck
[split $buf_rlo "\0"]
510 set buf_rlo
[lindex
$pck end
]
511 foreach p
[lrange
$pck 0 end-1
] {
512 merge_state
[encoding convertfrom
$p] ?O
514 rescan_done
$fd buf_rlo
$after
517 proc rescan_done
{fd buf after
} {
519 global file_states repo_config
522 if {![eof
$fd]} return
525 if {[incr rescan_active
-1] > 0} return
534 proc prune_selection
{} {
535 global file_states selected_paths
537 foreach path
[array names selected_paths
] {
538 if {[catch
{set still_here
$file_states($path)}]} {
539 unset selected_paths
($path)
544 ######################################################################
549 global ui_diff current_diff_path current_diff_header
550 global ui_index ui_workdir
552 $ui_diff conf
-state normal
553 $ui_diff delete
0.0 end
554 $ui_diff conf
-state disabled
556 set current_diff_path
{}
557 set current_diff_header
{}
559 $ui_index tag remove in_diff
0.0 end
560 $ui_workdir tag remove in_diff
0.0 end
563 proc reshow_diff
{} {
564 global ui_status_value file_states file_lists
565 global current_diff_path current_diff_side
567 set p
$current_diff_path
569 ||
$current_diff_side eq
{}
570 ||
[catch
{set s
$file_states($p)}]
571 ||
[lsearch
-sorted $file_lists($current_diff_side) $p] == -1} {
574 show_diff
$p $current_diff_side
578 proc handle_empty_diff
{} {
579 global current_diff_path file_states file_lists
581 set path
$current_diff_path
582 set s
$file_states($path)
583 if {[lindex
$s 0] ne
{_M
}} return
585 info_popup
"No differences detected.
587 [short_path $path] has no changes.
589 The modification date of this file was updated
590 by another application, but the content within
591 the file was not changed.
593 A rescan will be automatically started to find
594 other files which may have the same state."
597 display_file
$path __
598 rescan
{set ui_status_value
{Ready.
}} 0
601 proc show_diff
{path w
{lno
{}}} {
602 global file_states file_lists
603 global is_3way_diff diff_active repo_config
604 global ui_diff ui_status_value ui_index ui_workdir
605 global current_diff_path current_diff_side current_diff_header
607 if {$diff_active ||
![lock_index
read]} return
610 if {$w eq
{} ||
$lno == {}} {
611 foreach w
[array names file_lists
] {
612 set lno
[lsearch
-sorted $file_lists($w) $path]
619 if {$w ne
{} && $lno >= 1} {
620 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
623 set s
$file_states($path)
627 set current_diff_path
$path
628 set current_diff_side
$w
629 set current_diff_header
{}
630 set ui_status_value
"Loading diff of [escape_path $path]..."
632 # - Git won't give us the diff, there's nothing to compare to!
635 set max_sz
[expr {128 * 1024}]
637 set fd
[open
$path r
]
638 set content
[read $fd $max_sz]
640 set sz
[file size
$path]
644 set ui_status_value
"Unable to display [escape_path $path]"
645 error_popup
"Error loading file:\n\n$err"
648 $ui_diff conf
-state normal
649 if {![catch
{set type [exec file $path]}]} {
650 set n
[string length
$path]
651 if {[string equal
-length $n $path $type]} {
652 set type [string range
$type $n end
]
653 regsub
{^
:?\s
*} $type {} type
655 $ui_diff insert end
"* $type\n" d_@
657 if {[string first
"\0" $content] != -1} {
658 $ui_diff insert end \
659 "* Binary file (not showing content)." \
663 $ui_diff insert end \
664 "* Untracked file is $sz bytes.
665 * Showing only first $max_sz bytes.
668 $ui_diff insert end
$content
670 $ui_diff insert end
"
671 * Untracked file clipped here by [appname].
672 * To see the entire file, use an external editor.
676 $ui_diff conf
-state disabled
679 set ui_status_value
{Ready.
}
684 if {$w eq
$ui_index} {
685 lappend cmd diff-index
687 } elseif
{$w eq
$ui_workdir} {
688 if {[string index
$m 0] eq
{U
}} {
691 lappend cmd diff-files
696 lappend cmd
--no-color
697 if {$repo_config(gui.diffcontext
) > 0} {
698 lappend cmd
"-U$repo_config(gui.diffcontext)"
700 if {$w eq
$ui_index} {
706 if {[catch
{set fd
[open
$cmd r
]} err
]} {
709 set ui_status_value
"Unable to display [escape_path $path]"
710 error_popup
"Error loading diff:\n\n$err"
718 fileevent
$fd readable
[list read_diff
$fd]
721 proc read_diff
{fd
} {
722 global ui_diff ui_status_value diff_active
723 global is_3way_diff current_diff_header
725 $ui_diff conf
-state normal
726 while {[gets
$fd line
] >= 0} {
727 # -- Cleanup uninteresting diff header lines.
729 if { [string match
{diff --git *} $line]
730 ||
[string match
{diff --cc *} $line]
731 ||
[string match
{diff --combined *} $line]
732 ||
[string match
{--- *} $line]
733 ||
[string match
{+++ *} $line]} {
734 append current_diff_header
$line "\n"
737 if {[string match
{index
*} $line]} continue
738 if {$line eq
{deleted
file mode
120000}} {
739 set line
"deleted symlink"
742 # -- Automatically detect if this is a 3 way diff.
744 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
746 if {[string match
{mode
*} $line]
747 ||
[string match
{new
file *} $line]
748 ||
[string match
{deleted
file *} $line]
749 ||
[string match
{Binary files
* and
* differ
} $line]
750 ||
$line eq
{\ No newline
at end of
file}
751 ||
[regexp
{^\
* Unmerged path
} $line]} {
753 } elseif
{$is_3way_diff} {
754 set op
[string range
$line 0 1]
764 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
765 set line
[string replace
$line 0 1 { }]
772 puts
"error: Unhandled 3 way diff marker: {$op}"
777 set op
[string index
$line 0]
783 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
784 set line
[string replace
$line 0 0 { }]
791 puts
"error: Unhandled 2 way diff marker: {$op}"
796 $ui_diff insert end
$line $tags
797 if {[string index
$line end
] eq
"\r"} {
798 $ui_diff tag add d_cr
{end
- 2c
}
800 $ui_diff insert end
"\n" $tags
802 $ui_diff conf
-state disabled
808 set ui_status_value
{Ready.
}
810 if {[$ui_diff index end
] eq
{2.0}} {
816 proc apply_hunk
{x y
} {
817 global current_diff_path current_diff_header current_diff_side
818 global ui_diff ui_index file_states
820 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
821 if {![lock_index apply_hunk
]} return
823 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
824 set mi
[lindex
$file_states($current_diff_path) 0]
825 if {$current_diff_side eq
$ui_index} {
827 lappend apply_cmd
--reverse
828 if {[string index
$mi 0] ne
{M
}} {
834 if {[string index
$mi 1] ne
{M
}} {
840 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
841 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
847 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
853 set p
[open
"| $apply_cmd" w
]
854 fconfigure
$p -translation binary
-encoding binary
855 puts
-nonewline $p $current_diff_header
856 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
858 error_popup
"Failed to $mode selected hunk.\n\n$err"
863 $ui_diff conf
-state normal
864 $ui_diff delete
$s_lno $e_lno
865 $ui_diff conf
-state disabled
867 if {[$ui_diff get
1.0 end
] eq
"\n"} {
873 if {$current_diff_side eq
$ui_index} {
875 } elseif
{[string index
$mi 0] eq
{_
}} {
881 display_file
$current_diff_path $mi
887 ######################################################################
891 proc load_last_commit
{} {
892 global HEAD PARENT MERGE_HEAD commit_type ui_comm
895 if {[llength
$PARENT] == 0} {
896 error_popup
{There is nothing to amend.
898 You are about to create the initial commit.
899 There is no commit before this to amend.
904 repository_state curType curHEAD curMERGE_HEAD
905 if {$curType eq
{merge
}} {
906 error_popup
{Cannot amend
while merging.
908 You are currently
in the middle of a merge that
909 has not been fully completed. You cannot amend
910 the prior commit unless you first abort the
911 current merge activity.
919 set fd
[open
"| git cat-file commit $curHEAD" r
]
920 fconfigure
$fd -encoding binary
-translation lf
921 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
924 while {[gets
$fd line
] > 0} {
925 if {[string match
{parent
*} $line]} {
926 lappend parents
[string range
$line 7 end
]
927 } elseif
{[string match
{encoding
*} $line]} {
928 set enc
[string tolower
[string range
$line 9 end
]]
931 fconfigure
$fd -encoding $enc
932 set msg
[string trim
[read $fd]]
935 error_popup
"Error loading commit data for amend:\n\n$err"
941 set MERGE_HEAD
[list
]
942 switch
-- [llength
$parents] {
943 0 {set commit_type amend-initial
}
944 1 {set commit_type amend
}
945 default
{set commit_type amend-merge
}
948 $ui_comm delete
0.0 end
949 $ui_comm insert end
$msg
951 $ui_comm edit modified false
952 rescan
{set ui_status_value
{Ready.
}}
955 proc create_new_commit
{} {
956 global commit_type ui_comm
958 set commit_type normal
959 $ui_comm delete
0.0 end
961 $ui_comm edit modified false
962 rescan
{set ui_status_value
{Ready.
}}
965 set GIT_COMMITTER_IDENT
{}
967 proc committer_ident
{} {
968 global GIT_COMMITTER_IDENT
970 if {$GIT_COMMITTER_IDENT eq
{}} {
971 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
972 error_popup
"Unable to obtain your identity:\n\n$err"
975 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
976 $me me GIT_COMMITTER_IDENT
]} {
977 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
982 return $GIT_COMMITTER_IDENT
985 proc commit_tree
{} {
986 global HEAD commit_type file_states ui_comm repo_config
987 global ui_status_value pch_error
989 if {![lock_index update
]} return
990 if {[committer_ident
] eq
{}} return
992 # -- Our in memory state should match the repository.
994 repository_state curType curHEAD curMERGE_HEAD
995 if {[string match amend
* $commit_type]
996 && $curType eq
{normal
}
997 && $curHEAD eq
$HEAD} {
998 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
999 info_popup
{Last scanned state does not match repository state.
1001 Another Git program has modified this repository
1002 since the last scan. A rescan must be performed
1003 before another commit can be created.
1005 The rescan will be automatically started now.
1008 rescan
{set ui_status_value
{Ready.
}}
1012 # -- At least one file should differ in the index.
1015 foreach path
[array names file_states
] {
1016 switch
-glob -- [lindex
$file_states($path) 0] {
1020 M?
{set files_ready
1}
1022 error_popup
"Unmerged files cannot be committed.
1024 File [short_path $path] has merge conflicts.
1025 You must resolve them and add the file before committing.
1031 error_popup
"Unknown file state [lindex $s 0] detected.
1033 File [short_path $path] cannot be committed by this program.
1038 if {!$files_ready} {
1039 info_popup
{No changes to commit.
1041 You must add
at least
1 file before you can commit.
1047 # -- A message is required.
1049 set msg
[string trim
[$ui_comm get
1.0 end
]]
1050 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1052 error_popup
{Please supply a commit message.
1054 A good commit message has the following format
:
1056 - First line
: Describe
in one sentance what you did.
1057 - Second line
: Blank
1058 - Remaining lines
: Describe why this change is good.
1064 # -- Run the pre-commit hook.
1066 set pchook
[gitdir hooks pre-commit
]
1068 # On Cygwin [file executable] might lie so we need to ask
1069 # the shell if the hook is executable. Yes that's annoying.
1071 if {[is_Windows
] && [file isfile
$pchook]} {
1072 set pchook
[list sh
-c [concat \
1073 "if test -x \"$pchook\";" \
1074 "then exec \"$pchook\" 2>&1;" \
1076 } elseif
{[file executable
$pchook]} {
1077 set pchook
[list
$pchook |
& cat]
1079 commit_writetree
$curHEAD $msg
1083 set ui_status_value
{Calling pre-commit hook...
}
1085 set fd_ph
[open
"| $pchook" r
]
1086 fconfigure
$fd_ph -blocking 0 -translation binary
1087 fileevent
$fd_ph readable \
1088 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1091 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1092 global pch_error ui_status_value
1094 append pch_error
[read $fd_ph]
1095 fconfigure
$fd_ph -blocking 1
1097 if {[catch
{close
$fd_ph}]} {
1098 set ui_status_value
{Commit declined by pre-commit hook.
}
1099 hook_failed_popup pre-commit
$pch_error
1102 commit_writetree
$curHEAD $msg
1107 fconfigure
$fd_ph -blocking 0
1110 proc commit_writetree
{curHEAD msg
} {
1111 global ui_status_value
1113 set ui_status_value
{Committing changes...
}
1114 set fd_wt
[open
"| git write-tree" r
]
1115 fileevent
$fd_wt readable \
1116 [list commit_committree
$fd_wt $curHEAD $msg]
1119 proc commit_committree
{fd_wt curHEAD msg
} {
1120 global HEAD PARENT MERGE_HEAD commit_type
1121 global single_commit all_heads current_branch
1122 global ui_status_value ui_comm selected_commit_type
1123 global file_states selected_paths rescan_active
1127 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1128 error_popup
"write-tree failed:\n\n$err"
1129 set ui_status_value
{Commit failed.
}
1134 # -- Build the message.
1136 set msg_p
[gitdir COMMIT_EDITMSG
]
1137 set msg_wt
[open
$msg_p w
]
1138 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1141 fconfigure
$msg_wt -encoding $enc -translation binary
1142 puts
-nonewline $msg_wt $msg
1145 # -- Create the commit.
1147 set cmd
[list git commit-tree
$tree_id]
1148 set parents
[concat
$PARENT $MERGE_HEAD]
1149 if {[llength
$parents] > 0} {
1150 foreach p
$parents {
1154 # git commit-tree writes to stderr during initial commit.
1155 lappend cmd
2>/dev
/null
1158 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1159 error_popup
"commit-tree failed:\n\n$err"
1160 set ui_status_value
{Commit failed.
}
1165 # -- Update the HEAD ref.
1168 if {$commit_type ne
{normal
}} {
1169 append reflogm
" ($commit_type)"
1171 set i
[string first
"\n" $msg]
1173 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1175 append reflogm
{: } $msg
1177 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1178 if {[catch
{eval exec $cmd} err
]} {
1179 error_popup
"update-ref failed:\n\n$err"
1180 set ui_status_value
{Commit failed.
}
1185 # -- Make sure our current branch exists.
1187 if {$commit_type eq
{initial
}} {
1188 lappend all_heads
$current_branch
1189 set all_heads
[lsort
-unique $all_heads]
1190 populate_branch_menu
1193 # -- Cleanup after ourselves.
1195 catch
{file delete
$msg_p}
1196 catch
{file delete
[gitdir MERGE_HEAD
]}
1197 catch
{file delete
[gitdir MERGE_MSG
]}
1198 catch
{file delete
[gitdir SQUASH_MSG
]}
1199 catch
{file delete
[gitdir GITGUI_MSG
]}
1201 # -- Let rerere do its thing.
1203 if {[file isdirectory
[gitdir rr-cache
]]} {
1204 catch
{exec git rerere
}
1207 # -- Run the post-commit hook.
1209 set pchook
[gitdir hooks post-commit
]
1210 if {[is_Windows
] && [file isfile
$pchook]} {
1211 set pchook
[list sh
-c [concat \
1212 "if test -x \"$pchook\";" \
1213 "then exec \"$pchook\";" \
1215 } elseif
{![file executable
$pchook]} {
1218 if {$pchook ne
{}} {
1219 catch
{exec $pchook &}
1222 $ui_comm delete
0.0 end
1224 $ui_comm edit modified false
1226 if {$single_commit} do_quit
1228 # -- Update in memory status
1230 set selected_commit_type new
1231 set commit_type normal
1234 set MERGE_HEAD
[list
]
1236 foreach path
[array names file_states
] {
1237 set s
$file_states($path)
1239 switch
-glob -- $m {
1247 unset file_states
($path)
1248 catch
{unset selected_paths
($path)}
1251 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1257 set file_states
($path) [list \
1258 _
[string index
$m 1] \
1269 set ui_status_value \
1270 "Changes committed as [string range $cmt_id 0 7]."
1273 ######################################################################
1277 proc fetch_from
{remote
} {
1278 set w
[new_console
"fetch $remote" \
1279 "Fetching new changes from $remote"]
1280 set cmd
[list git fetch
]
1282 console_exec
$w $cmd
1285 proc pull_remote
{remote branch
} {
1286 global HEAD commit_type file_states repo_config
1288 if {![lock_index update
]} return
1290 # -- Our in memory state should match the repository.
1292 repository_state curType curHEAD curMERGE_HEAD
1293 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1294 info_popup
{Last scanned state does not match repository state.
1296 Another Git program has modified this repository
1297 since the last scan. A rescan must be performed
1298 before a pull operation can be started.
1300 The rescan will be automatically started now.
1303 rescan
{set ui_status_value
{Ready.
}}
1307 # -- No differences should exist before a pull.
1309 if {[array size file_states
] != 0} {
1310 error_popup
{Uncommitted but modified files are present.
1312 You should not perform a pull with unmodified
1313 files
in your working directory as Git will be
1314 unable to recover from an incorrect merge.
1316 You should commit or revert all changes before
1317 starting a pull operation.
1323 set w
[new_console
"pull $remote $branch" \
1324 "Pulling new changes from branch $branch in $remote"]
1325 set cmd
[list git pull
]
1326 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1327 lappend cmd
--no-summary
1331 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1334 proc post_pull_remote
{remote branch success
} {
1335 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1336 global ui_status_value
1340 repository_state commit_type HEAD MERGE_HEAD
1342 set selected_commit_type new
1343 set ui_status_value
"Pulling $branch from $remote complete."
1345 rescan
[list
set ui_status_value \
1346 "Conflicts detected while pulling $branch from $remote."]
1350 proc push_to
{remote
} {
1351 set w
[new_console
"push $remote" \
1352 "Pushing changes to $remote"]
1353 set cmd
[list git push
]
1355 console_exec
$w $cmd
1358 ######################################################################
1362 proc mapicon
{w state path
} {
1365 if {[catch
{set r
$all_icons($state$w)}]} {
1366 puts
"error: no icon for $w state={$state} $path"
1372 proc mapdesc
{state path
} {
1375 if {[catch
{set r
$all_descs($state)}]} {
1376 puts
"error: no desc for state={$state} $path"
1382 proc escape_path
{path
} {
1383 regsub
-all "\n" $path "\\n" path
1387 proc short_path
{path
} {
1388 return [escape_path
[lindex
[file split $path] end
]]
1392 set null_sha1
[string repeat
0 40]
1394 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1395 global file_states next_icon_id null_sha1
1397 set s0
[string index
$new_state 0]
1398 set s1
[string index
$new_state 1]
1400 if {[catch
{set info
$file_states($path)}]} {
1402 set icon n
[incr next_icon_id
]
1404 set state
[lindex
$info 0]
1405 set icon
[lindex
$info 1]
1406 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1407 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1410 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1411 elseif
{$s0 eq
{_
}} {set s0 _
}
1413 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1414 elseif
{$s1 eq
{_
}} {set s1 _
}
1416 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1417 set head_info
[list
0 $null_sha1]
1418 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1419 && $head_info eq
{}} {
1420 set head_info
$index_info
1423 set file_states
($path) [list
$s0$s1 $icon \
1424 $head_info $index_info \
1429 proc display_file_helper
{w path icon_name old_m new_m
} {
1432 if {$new_m eq
{_
}} {
1433 set lno
[lsearch
-sorted $file_lists($w) $path]
1435 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1437 $w conf
-state normal
1438 $w delete
$lno.0 [expr {$lno + 1}].0
1439 $w conf
-state disabled
1441 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1442 lappend file_lists
($w) $path
1443 set file_lists
($w) [lsort
-unique $file_lists($w)]
1444 set lno
[lsearch
-sorted $file_lists($w) $path]
1446 $w conf
-state normal
1447 $w image create
$lno.0 \
1448 -align center
-padx 5 -pady 1 \
1450 -image [mapicon
$w $new_m $path]
1451 $w insert
$lno.1 "[escape_path $path]\n"
1452 $w conf
-state disabled
1453 } elseif
{$old_m ne
$new_m} {
1454 $w conf
-state normal
1455 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1456 $w conf
-state disabled
1460 proc display_file
{path state
} {
1461 global file_states selected_paths
1462 global ui_index ui_workdir
1464 set old_m
[merge_state
$path $state]
1465 set s
$file_states($path)
1466 set new_m
[lindex
$s 0]
1467 set icon_name
[lindex
$s 1]
1469 set o
[string index
$old_m 0]
1470 set n
[string index
$new_m 0]
1477 display_file_helper
$ui_index $path $icon_name $o $n
1479 if {[string index
$old_m 0] eq
{U
}} {
1482 set o
[string index
$old_m 1]
1484 if {[string index
$new_m 0] eq
{U
}} {
1487 set n
[string index
$new_m 1]
1489 display_file_helper
$ui_workdir $path $icon_name $o $n
1491 if {$new_m eq
{__
}} {
1492 unset file_states
($path)
1493 catch
{unset selected_paths
($path)}
1497 proc display_all_files_helper
{w path icon_name m
} {
1500 lappend file_lists
($w) $path
1501 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1502 $w image create end \
1503 -align center
-padx 5 -pady 1 \
1505 -image [mapicon
$w $m $path]
1506 $w insert end
"[escape_path $path]\n"
1509 proc display_all_files
{} {
1510 global ui_index ui_workdir
1511 global file_states file_lists
1514 $ui_index conf
-state normal
1515 $ui_workdir conf
-state normal
1517 $ui_index delete
0.0 end
1518 $ui_workdir delete
0.0 end
1521 set file_lists
($ui_index) [list
]
1522 set file_lists
($ui_workdir) [list
]
1524 foreach path
[lsort
[array names file_states
]] {
1525 set s
$file_states($path)
1527 set icon_name
[lindex
$s 1]
1529 set s
[string index
$m 0]
1530 if {$s ne
{U
} && $s ne
{_
}} {
1531 display_all_files_helper
$ui_index $path \
1535 if {[string index
$m 0] eq
{U
}} {
1538 set s
[string index
$m 1]
1541 display_all_files_helper
$ui_workdir $path \
1546 $ui_index conf
-state disabled
1547 $ui_workdir conf
-state disabled
1550 proc update_indexinfo
{msg pathList after
} {
1551 global update_index_cp ui_status_value
1553 if {![lock_index update
]} return
1555 set update_index_cp
0
1556 set pathList
[lsort
$pathList]
1557 set totalCnt
[llength
$pathList]
1558 set batch [expr {int
($totalCnt * .01) + 1}]
1559 if {$batch > 25} {set batch 25}
1561 set ui_status_value
[format \
1562 "$msg... %i/%i files (%.2f%%)" \
1566 set fd
[open
"| git update-index -z --index-info" w
]
1573 fileevent
$fd writable
[list \
1574 write_update_indexinfo \
1584 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1585 global update_index_cp ui_status_value
1586 global file_states current_diff_path
1588 if {$update_index_cp >= $totalCnt} {
1595 for {set i
$batch} \
1596 {$update_index_cp < $totalCnt && $i > 0} \
1598 set path
[lindex
$pathList $update_index_cp]
1599 incr update_index_cp
1601 set s
$file_states($path)
1602 switch
-glob -- [lindex
$s 0] {
1609 set info
[lindex
$s 2]
1610 if {$info eq
{}} continue
1612 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1613 display_file
$path $new
1616 set ui_status_value
[format \
1617 "$msg... %i/%i files (%.2f%%)" \
1620 [expr {100.0 * $update_index_cp / $totalCnt}]]
1623 proc update_index
{msg pathList after
} {
1624 global update_index_cp ui_status_value
1626 if {![lock_index update
]} return
1628 set update_index_cp
0
1629 set pathList
[lsort
$pathList]
1630 set totalCnt
[llength
$pathList]
1631 set batch [expr {int
($totalCnt * .01) + 1}]
1632 if {$batch > 25} {set batch 25}
1634 set ui_status_value
[format \
1635 "$msg... %i/%i files (%.2f%%)" \
1639 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1646 fileevent
$fd writable
[list \
1647 write_update_index \
1657 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1658 global update_index_cp ui_status_value
1659 global file_states current_diff_path
1661 if {$update_index_cp >= $totalCnt} {
1668 for {set i
$batch} \
1669 {$update_index_cp < $totalCnt && $i > 0} \
1671 set path
[lindex
$pathList $update_index_cp]
1672 incr update_index_cp
1674 switch
-glob -- [lindex
$file_states($path) 0] {
1680 if {[file exists
$path]} {
1689 puts
-nonewline $fd "[encoding convertto $path]\0"
1690 display_file
$path $new
1693 set ui_status_value
[format \
1694 "$msg... %i/%i files (%.2f%%)" \
1697 [expr {100.0 * $update_index_cp / $totalCnt}]]
1700 proc checkout_index
{msg pathList after
} {
1701 global update_index_cp ui_status_value
1703 if {![lock_index update
]} return
1705 set update_index_cp
0
1706 set pathList
[lsort
$pathList]
1707 set totalCnt
[llength
$pathList]
1708 set batch [expr {int
($totalCnt * .01) + 1}]
1709 if {$batch > 25} {set batch 25}
1711 set ui_status_value
[format \
1712 "$msg... %i/%i files (%.2f%%)" \
1716 set cmd
[list git checkout-index
]
1722 set fd
[open
"| $cmd " w
]
1729 fileevent
$fd writable
[list \
1730 write_checkout_index \
1740 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1741 global update_index_cp ui_status_value
1742 global file_states current_diff_path
1744 if {$update_index_cp >= $totalCnt} {
1751 for {set i
$batch} \
1752 {$update_index_cp < $totalCnt && $i > 0} \
1754 set path
[lindex
$pathList $update_index_cp]
1755 incr update_index_cp
1756 switch
-glob -- [lindex
$file_states($path) 0] {
1760 puts
-nonewline $fd "[encoding convertto $path]\0"
1761 display_file
$path ?_
1766 set ui_status_value
[format \
1767 "$msg... %i/%i files (%.2f%%)" \
1770 [expr {100.0 * $update_index_cp / $totalCnt}]]
1773 ######################################################################
1775 ## branch management
1777 proc is_tracking_branch
{name
} {
1778 global tracking_branches
1780 if {![catch
{set info
$tracking_branches($name)}]} {
1783 foreach t
[array names tracking_branches
] {
1784 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1791 proc load_all_heads
{} {
1794 set all_heads
[list
]
1795 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1796 while {[gets
$fd line
] > 0} {
1797 if {[is_tracking_branch
$line]} continue
1798 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1799 lappend all_heads
$name
1803 set all_heads
[lsort
$all_heads]
1806 proc populate_branch_menu
{} {
1807 global all_heads disable_on_lock
1810 set last
[$m index last
]
1811 for {set i
0} {$i <= $last} {incr i
} {
1812 if {[$m type $i] eq
{separator
}} {
1815 foreach a
$disable_on_lock {
1816 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1820 set disable_on_lock
$new_dol
1826 foreach b
$all_heads {
1827 $m add radiobutton \
1829 -command [list switch_branch
$b] \
1830 -variable current_branch \
1833 lappend disable_on_lock \
1834 [list
$m entryconf
[$m index last
] -state]
1838 proc all_tracking_branches
{} {
1839 global tracking_branches
1841 set all_trackings
{}
1843 foreach name
[array names tracking_branches
] {
1844 if {[regsub
{/\
*$
} $name {} name
]} {
1847 regsub ^refs
/(heads|remotes
)/ $name {} name
1848 lappend all_trackings
$name
1853 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1854 while {[gets
$fd name
] > 0} {
1855 regsub ^refs
/(heads|remotes
)/ $name {} name
1856 lappend all_trackings
$name
1861 return [lsort
-unique $all_trackings]
1864 proc do_create_branch_action
{w
} {
1865 global all_heads null_sha1 repo_config
1866 global create_branch_checkout create_branch_revtype
1867 global create_branch_head create_branch_trackinghead
1869 set newbranch
[string trim
[$w.desc.name_t get
0.0 end
]]
1870 if {$newbranch eq
{}
1871 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1875 -title [wm title
$w] \
1877 -message "Please supply a branch name."
1878 focus
$w.desc.name_t
1881 if {![catch
{exec git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1885 -title [wm title
$w] \
1887 -message "Branch '$newbranch' already exists."
1888 focus
$w.desc.name_t
1891 if {[catch
{exec git check-ref-format
"heads/$newbranch"}]} {
1895 -title [wm title
$w] \
1897 -message "We do not like '$newbranch' as a branch name."
1898 focus
$w.desc.name_t
1903 switch
-- $create_branch_revtype {
1904 head {set rev $create_branch_head}
1905 tracking
{set rev $create_branch_trackinghead}
1906 expression
{set rev [string trim
[$w.from.exp_t get
0.0 end
]]}
1908 if {[catch
{set cmt
[exec git rev-parse
--verify "${rev}^0"]}]} {
1912 -title [wm title
$w] \
1914 -message "Invalid starting revision: $rev"
1917 set cmd
[list git update-ref
]
1919 lappend cmd
"branch: Created from $rev"
1920 lappend cmd
"refs/heads/$newbranch"
1922 lappend cmd
$null_sha1
1923 if {[catch
{eval exec $cmd} err
]} {
1927 -title [wm title
$w] \
1929 -message "Failed to create '$newbranch'.\n\n$err"
1933 lappend all_heads
$newbranch
1934 set all_heads
[lsort
$all_heads]
1935 populate_branch_menu
1937 if {$create_branch_checkout} {
1938 switch_branch
$newbranch
1942 proc radio_selector
{varname value args
} {
1943 upvar
#0 $varname var
1947 trace add variable create_branch_head
write \
1948 [list radio_selector create_branch_revtype
head]
1949 trace add variable create_branch_trackinghead
write \
1950 [list radio_selector create_branch_revtype tracking
]
1952 trace add variable delete_branch_head
write \
1953 [list radio_selector delete_branch_checktype
head]
1954 trace add variable delete_branch_trackinghead
write \
1955 [list radio_selector delete_branch_checktype tracking
]
1957 proc do_create_branch
{} {
1958 global all_heads current_branch repo_config
1959 global create_branch_checkout create_branch_revtype
1960 global create_branch_head create_branch_trackinghead
1962 set w .branch_editor
1964 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
1966 label
$w.header
-text {Create New Branch
} \
1968 pack
$w.header
-side top
-fill x
1971 button
$w.buttons.create
-text Create \
1974 -command [list do_create_branch_action
$w]
1975 pack
$w.buttons.create
-side right
1976 button
$w.buttons.cancel
-text {Cancel
} \
1978 -command [list destroy
$w]
1979 pack
$w.buttons.cancel
-side right
-padx 5
1980 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
1982 labelframe
$w.desc \
1983 -text {Branch Description
} \
1985 label
$w.desc.name_l
-text {Name
:} -font font_ui
1986 text
$w.desc.name_t \
1992 $w.desc.name_t insert
0.0 $repo_config(gui.newbranchtemplate
)
1993 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
1994 bind $w.desc.name_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
1995 bind $w.desc.name_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
1996 bind $w.desc.name_t
<Key-Return
> "do_create_branch_action $w;break"
1997 bind $w.desc.name_t
<Key
> {
1998 if {{%K
} ne
{BackSpace
}
2001 && {%K
} ne
{Return
}} {
2003 if {[string first
%A
{~^
:?
*[}] >= 0} break
2006 grid columnconfigure
$w.desc
1 -weight 1
2007 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2009 labelframe
$w.from \
2010 -text {Starting Revision
} \
2012 radiobutton
$w.from.head_r \
2013 -text {Local Branch
:} \
2015 -variable create_branch_revtype \
2017 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2018 grid
$w.from.head_r
$w.from.head_m
-sticky w
2019 set all_trackings
[all_tracking_branches
]
2020 if {$all_trackings ne
{}} {
2021 set create_branch_trackinghead
[lindex
$all_trackings 0]
2022 radiobutton
$w.from.tracking_r \
2023 -text {Tracking Branch
:} \
2025 -variable create_branch_revtype \
2027 eval tk_optionMenu
$w.from.tracking_m \
2028 create_branch_trackinghead \
2030 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2032 radiobutton
$w.from.exp_r \
2033 -text {Revision Expression
:} \
2035 -variable create_branch_revtype \
2037 text
$w.from.exp_t \
2043 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2044 bind $w.from.exp_t
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
2045 bind $w.from.exp_t
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
2046 bind $w.from.exp_t
<Key-Return
> "do_create_branch_action $w;break"
2047 bind $w.from.exp_t
<Key-space
> break
2048 bind $w.from.exp_t
<Key
> {set create_branch_revtype expression
}
2049 grid columnconfigure
$w.from
1 -weight 1
2050 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2052 labelframe
$w.postActions \
2053 -text {Post Creation Actions
} \
2055 checkbutton
$w.postActions.checkout \
2056 -text {Checkout after creation
} \
2057 -variable create_branch_checkout \
2059 pack
$w.postActions.checkout
-anchor nw
2060 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2062 set create_branch_checkout
1
2063 set create_branch_head
$current_branch
2064 set create_branch_revtype
head
2066 bind $w <Visibility
> "grab $w; focus $w.desc.name_t"
2067 bind $w <Key-Escape
> "destroy $w"
2068 bind $w <Key-Return
> "do_create_branch_action $w;break"
2069 wm title
$w "[appname] ([reponame]): Create Branch"
2073 proc do_delete_branch_action
{w
} {
2075 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2078 switch
-- $delete_branch_checktype {
2079 head {set check_rev
$delete_branch_head}
2080 tracking
{set check_rev
$delete_branch_trackinghead}
2081 always
{set check_rev
{:none
}}
2083 if {$check_rev eq
{:none
}} {
2085 } elseif
{[catch
{set check_cmt
[exec git rev-parse
--verify "${check_rev}^0"]}]} {
2089 -title [wm title
$w] \
2091 -message "Invalid check revision: $check_rev"
2095 set to_delete
[list
]
2096 set not_merged
[list
]
2097 foreach i
[$w.list.l curselection
] {
2098 set b
[$w.list.l get
$i]
2099 if {[catch
{set o
[exec git rev-parse
--verify $b]}]} continue
2100 if {$check_cmt ne
{}} {
2101 if {$b eq
$check_rev} continue
2102 if {[catch
{set m
[exec git merge-base
$o $check_cmt]}]} continue
2104 lappend not_merged
$b
2108 lappend to_delete
[list
$b $o]
2110 if {$not_merged ne
{}} {
2111 set msg
"The following branches are not completely merged into $check_rev:
2113 - [join $not_merged "\n - "]"
2117 -title [wm title
$w] \
2121 if {$to_delete eq
{}} return
2122 if {$delete_branch_checktype eq
{always
}} {
2123 set msg
{Recovering deleted branches is difficult.
2125 Delete the selected branches?
}
2126 if {[tk_messageBox \
2129 -title [wm title
$w] \
2131 -message $msg] ne
yes} {
2137 foreach i
$to_delete {
2140 if {[catch
{exec git update-ref
-d "refs/heads/$b" $o} err
]} {
2141 append failed
" - $b: $err\n"
2143 set x
[lsearch
-sorted $all_heads $b]
2145 set all_heads
[lreplace
$all_heads $x $x]
2150 if {$failed ne
{}} {
2154 -title [wm title
$w] \
2156 -message "Failed to delete branches:\n$failed"
2159 set all_heads
[lsort
$all_heads]
2160 populate_branch_menu
2164 proc do_delete_branch
{} {
2165 global all_heads tracking_branches current_branch
2166 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2168 set w .branch_editor
2170 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2172 label
$w.header
-text {Delete Local Branch
} \
2174 pack
$w.header
-side top
-fill x
2177 button
$w.buttons.create
-text Delete \
2179 -command [list do_delete_branch_action
$w]
2180 pack
$w.buttons.create
-side right
2181 button
$w.buttons.cancel
-text {Cancel
} \
2183 -command [list destroy
$w]
2184 pack
$w.buttons.cancel
-side right
-padx 5
2185 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2187 labelframe
$w.list \
2188 -text {Local Branches
} \
2193 -selectmode extended \
2195 foreach h
$all_heads {
2196 if {$h ne
$current_branch} {
2197 $w.list.l insert end
$h
2200 pack
$w.list.l
-fill both
-pady 5 -padx 5
2201 pack
$w.list
-fill both
-pady 5 -padx 5
2203 labelframe
$w.validate \
2204 -text {Delete Only If
} \
2206 radiobutton
$w.validate.head_r \
2207 -text {Merged Into Local Branch
:} \
2209 -variable delete_branch_checktype \
2211 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2212 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2213 set all_trackings
[all_tracking_branches
]
2214 if {$all_trackings ne
{}} {
2215 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2216 radiobutton
$w.validate.tracking_r \
2217 -text {Merged Into Tracking Branch
:} \
2219 -variable delete_branch_checktype \
2221 eval tk_optionMenu
$w.validate.tracking_m \
2222 delete_branch_trackinghead \
2224 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2226 radiobutton
$w.validate.always_r \
2227 -text {Always
(Do not perform merge checks
)} \
2229 -variable delete_branch_checktype \
2231 grid
$w.validate.always_r
-columnspan 2 -sticky w
2232 grid columnconfigure
$w.validate
1 -weight 1
2233 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2235 set delete_branch_head
$current_branch
2236 set delete_branch_checktype
head
2238 bind $w <Visibility
> "grab $w; focus $w"
2239 bind $w <Key-Escape
> "destroy $w"
2240 wm title
$w "[appname] ([reponame]): Delete Branch"
2244 proc switch_branch
{new_branch
} {
2245 global HEAD commit_type current_branch repo_config
2247 if {![lock_index switch
]} return
2249 # -- Our in memory state should match the repository.
2251 repository_state curType curHEAD curMERGE_HEAD
2252 if {[string match amend
* $commit_type]
2253 && $curType eq
{normal
}
2254 && $curHEAD eq
$HEAD} {
2255 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2256 info_popup
{Last scanned state does not match repository state.
2258 Another Git program has modified this repository
2259 since the last scan. A rescan must be performed
2260 before the current branch can be changed.
2262 The rescan will be automatically started now.
2265 rescan
{set ui_status_value
{Ready.
}}
2269 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2270 switch_branch_stage2
{} $new_branch
2272 set ui_status_value
{Refreshing
file status...
}
2273 set cmd
[list git update-index
]
2275 lappend cmd
--unmerged
2276 lappend cmd
--ignore-missing
2277 lappend cmd
--refresh
2278 set fd_rf
[open
"| $cmd" r
]
2279 fconfigure
$fd_rf -blocking 0 -translation binary
2280 fileevent
$fd_rf readable \
2281 [list switch_branch_stage2
$fd_rf $new_branch]
2285 proc switch_branch_stage2
{fd_rf new_branch
} {
2286 global ui_status_value HEAD
2290 if {![eof
$fd_rf]} return
2294 set ui_status_value
"Updating working directory to '$new_branch'..."
2295 set cmd
[list git read-tree
]
2298 lappend cmd
--exclude-per-directory=.gitignore
2300 lappend cmd
$new_branch
2301 set fd_rt
[open
"| $cmd" r
]
2302 fconfigure
$fd_rt -blocking 0 -translation binary
2303 fileevent
$fd_rt readable \
2304 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2307 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2308 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2309 global current_branch
2310 global ui_comm ui_status_value
2312 # -- We never get interesting output on stdout; only stderr.
2315 fconfigure
$fd_rt -blocking 1
2316 if {![eof
$fd_rt]} {
2317 fconfigure
$fd_rt -blocking 0
2321 # -- The working directory wasn't in sync with the index and
2322 # we'd have to overwrite something to make the switch. A
2323 # merge is required.
2325 if {[catch
{close
$fd_rt} err
]} {
2326 regsub
{^fatal
: } $err {} err
2327 warn_popup
"File level merge required.
2331 Staying on branch '$current_branch'."
2332 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2337 # -- Update the symbolic ref. Core git doesn't even check for failure
2338 # here, it Just Works(tm). If it doesn't we are in some really ugly
2339 # state that is difficult to recover from within git-gui.
2341 if {[catch
{exec git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2342 error_popup
"Failed to set current branch.
2344 This working directory is only partially switched.
2345 We successfully updated your files, but failed to
2346 update an internal Git file.
2348 This should not have occurred. [appname] will now
2356 # -- Update our repository state. If we were previously in amend mode
2357 # we need to toss the current buffer and do a full rescan to update
2358 # our file lists. If we weren't in amend mode our file lists are
2359 # accurate and we can avoid the rescan.
2362 set selected_commit_type new
2363 if {[string match amend
* $commit_type]} {
2364 $ui_comm delete
0.0 end
2366 $ui_comm edit modified false
2367 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2369 repository_state commit_type HEAD MERGE_HEAD
2371 set ui_status_value
"Checked out branch '$current_branch'."
2375 ######################################################################
2377 ## remote management
2379 proc load_all_remotes
{} {
2381 global all_remotes tracking_branches
2383 set all_remotes
[list
]
2384 array
unset tracking_branches
2386 set rm_dir
[gitdir remotes
]
2387 if {[file isdirectory
$rm_dir]} {
2388 set all_remotes
[glob \
2392 -directory $rm_dir *]
2394 foreach name
$all_remotes {
2396 set fd
[open
[file join $rm_dir $name] r
]
2397 while {[gets
$fd line
] >= 0} {
2398 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2399 $line line src dst
]} continue
2400 if {![regexp ^refs
/ $dst]} {
2401 set dst
"refs/heads/$dst"
2403 set tracking_branches
($dst) [list
$name $src]
2410 foreach line
[array names repo_config remote.
*.url
] {
2411 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2412 lappend all_remotes
$name
2414 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2418 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2419 if {![regexp ^refs
/ $dst]} {
2420 set dst
"refs/heads/$dst"
2422 set tracking_branches
($dst) [list
$name $src]
2426 set all_remotes
[lsort
-unique $all_remotes]
2429 proc populate_fetch_menu
{m
} {
2430 global all_remotes repo_config
2432 foreach r
$all_remotes {
2434 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2435 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2440 set fd
[open
[gitdir remotes
$r] r
]
2441 while {[gets
$fd n
] >= 0} {
2442 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2453 -label "Fetch from $r..." \
2454 -command [list fetch_from
$r] \
2460 proc populate_push_menu
{m
} {
2461 global all_remotes repo_config
2463 foreach r
$all_remotes {
2465 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2466 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2471 set fd
[open
[gitdir remotes
$r] r
]
2472 while {[gets
$fd n
] >= 0} {
2473 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2484 -label "Push to $r..." \
2485 -command [list push_to
$r] \
2491 proc populate_pull_menu
{m
} {
2492 global repo_config all_remotes disable_on_lock
2494 foreach remote
$all_remotes {
2496 if {[array get repo_config remote.
$remote.url
] ne
{}} {
2497 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
2498 foreach line
$repo_config(remote.
$remote.fetch
) {
2499 if {[regexp
{^
([^
:]+):} $line line rb
]} {
2506 set fd
[open
[gitdir remotes
$remote] r
]
2507 while {[gets
$fd line
] >= 0} {
2508 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
2516 foreach rb
$rb_list {
2517 regsub ^refs
/heads
/ $rb {} rb_short
2519 -label "Branch $rb_short from $remote..." \
2520 -command [list pull_remote
$remote $rb] \
2522 lappend disable_on_lock \
2523 [list
$m entryconf
[$m index last
] -state]
2528 ######################################################################
2533 #define mask_width 14
2534 #define mask_height 15
2535 static unsigned char mask_bits
[] = {
2536 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2537 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
2538 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
2541 image create bitmap file_plain
-background white
-foreground black
-data {
2542 #define plain_width 14
2543 #define plain_height 15
2544 static unsigned char plain_bits
[] = {
2545 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2546 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
2547 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2548 } -maskdata $filemask
2550 image create bitmap file_mod
-background white
-foreground blue
-data {
2551 #define mod_width 14
2552 #define mod_height 15
2553 static unsigned char mod_bits
[] = {
2554 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2555 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2556 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2557 } -maskdata $filemask
2559 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
2560 #define file_fulltick_width 14
2561 #define file_fulltick_height 15
2562 static unsigned char file_fulltick_bits
[] = {
2563 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
2564 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
2565 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2566 } -maskdata $filemask
2568 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
2569 #define parttick_width 14
2570 #define parttick_height 15
2571 static unsigned char parttick_bits
[] = {
2572 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
2573 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
2574 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2575 } -maskdata $filemask
2577 image create bitmap file_question
-background white
-foreground black
-data {
2578 #define file_question_width 14
2579 #define file_question_height 15
2580 static unsigned char file_question_bits
[] = {
2581 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
2582 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
2583 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
2584 } -maskdata $filemask
2586 image create bitmap file_removed
-background white
-foreground red
-data {
2587 #define file_removed_width 14
2588 #define file_removed_height 15
2589 static unsigned char file_removed_bits
[] = {
2590 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
2591 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
2592 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
2593 } -maskdata $filemask
2595 image create bitmap file_merge
-background white
-foreground blue
-data {
2596 #define file_merge_width 14
2597 #define file_merge_height 15
2598 static unsigned char file_merge_bits
[] = {
2599 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
2600 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
2601 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
2602 } -maskdata $filemask
2604 set ui_index .vpane.files.index.list
2605 set ui_workdir .vpane.files.workdir.list
2607 set all_icons
(_
$ui_index) file_plain
2608 set all_icons
(A
$ui_index) file_fulltick
2609 set all_icons
(M
$ui_index) file_fulltick
2610 set all_icons
(D
$ui_index) file_removed
2611 set all_icons
(U
$ui_index) file_merge
2613 set all_icons
(_
$ui_workdir) file_plain
2614 set all_icons
(M
$ui_workdir) file_mod
2615 set all_icons
(D
$ui_workdir) file_question
2616 set all_icons
(U
$ui_workdir) file_merge
2617 set all_icons
(O
$ui_workdir) file_plain
2619 set max_status_desc
0
2623 {_M
"Modified, not staged"}
2624 {M_
"Staged for commit"}
2625 {MM
"Portions staged for commit"}
2626 {MD
"Staged for commit, missing"}
2628 {_O
"Untracked, not staged"}
2629 {A_
"Staged for commit"}
2630 {AM
"Portions staged for commit"}
2631 {AD
"Staged for commit, missing"}
2634 {D_
"Staged for removal"}
2635 {DO
"Staged for removal, still present"}
2637 {U_
"Requires merge resolution"}
2638 {UU
"Requires merge resolution"}
2639 {UM
"Requires merge resolution"}
2640 {UD
"Requires merge resolution"}
2642 if {$max_status_desc < [string length
[lindex
$i 1]]} {
2643 set max_status_desc
[string length
[lindex
$i 1]]
2645 set all_descs
([lindex
$i 0]) [lindex
$i 1]
2649 ######################################################################
2654 global tcl_platform tk_library
2655 if {[tk windowingsystem
] eq
{aqua
}} {
2661 proc is_Windows
{} {
2663 if {$tcl_platform(platform
) eq
{windows
}} {
2669 proc bind_button3
{w cmd
} {
2670 bind $w <Any-Button-3
> $cmd
2672 bind $w <Control-Button-1
> $cmd
2676 proc incr_font_size
{font
{amt
1}} {
2677 set sz
[font configure
$font -size]
2679 font configure
$font -size $sz
2680 font configure
${font}bold
-size $sz
2683 proc hook_failed_popup
{hook msg
} {
2688 label
$w.m.l1
-text "$hook hook failed:" \
2693 -background white
-borderwidth 1 \
2695 -width 80 -height 10 \
2697 -yscrollcommand [list
$w.m.sby
set]
2699 -text {You must correct the above errors before committing.
} \
2703 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2704 pack
$w.m.l1
-side top
-fill x
2705 pack
$w.m.l2
-side bottom
-fill x
2706 pack
$w.m.sby
-side right
-fill y
2707 pack
$w.m.t
-side left
-fill both
-expand 1
2708 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2710 $w.m.t insert
1.0 $msg
2711 $w.m.t conf
-state disabled
2713 button
$w.ok
-text OK \
2716 -command "destroy $w"
2717 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2719 bind $w <Visibility
> "grab $w; focus $w"
2720 bind $w <Key-Return
> "destroy $w"
2721 wm title
$w "[appname] ([reponame]): error"
2725 set next_console_id
0
2727 proc new_console
{short_title long_title
} {
2728 global next_console_id console_data
2729 set w .console
[incr next_console_id
]
2730 set console_data
($w) [list
$short_title $long_title]
2731 return [console_init
$w]
2734 proc console_init
{w
} {
2735 global console_cr console_data M1B
2737 set console_cr
($w) 1.0
2740 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2745 -background white
-borderwidth 1 \
2747 -width 80 -height 10 \
2750 -yscrollcommand [list
$w.m.sby
set]
2751 label
$w.m.s
-text {Working... please
wait...
} \
2755 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2756 pack
$w.m.l1
-side top
-fill x
2757 pack
$w.m.s
-side bottom
-fill x
2758 pack
$w.m.sby
-side right
-fill y
2759 pack
$w.m.t
-side left
-fill both
-expand 1
2760 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2762 menu
$w.ctxm
-tearoff 0
2763 $w.ctxm add
command -label "Copy" \
2765 -command "tk_textCopy $w.m.t"
2766 $w.ctxm add
command -label "Select All" \
2768 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
2769 $w.ctxm add
command -label "Copy All" \
2772 $w.m.t tag add sel 0.0 end
2774 $w.m.t tag remove sel 0.0 end
2777 button
$w.ok
-text {Close
} \
2780 -command "destroy $w"
2781 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2783 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2784 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2785 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2786 bind $w <Visibility
> "focus $w"
2787 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2791 proc console_exec
{w cmd
{after
{}}} {
2792 # -- Windows tosses the enviroment when we exec our child.
2793 # But most users need that so we have to relogin. :-(
2796 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2799 # -- Tcl won't let us redirect both stdout and stderr to
2800 # the same pipe. So pass it through cat...
2802 set cmd
[concat |
$cmd |
& cat]
2804 set fd_f
[open
$cmd r
]
2805 fconfigure
$fd_f -blocking 0 -translation binary
2806 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2809 proc console_read
{w fd after
} {
2810 global console_cr console_data
2814 if {![winfo exists
$w]} {console_init
$w}
2815 $w.m.t conf
-state normal
2817 set n
[string length
$buf]
2819 set cr
[string first
"\r" $buf $c]
2820 set lf
[string first
"\n" $buf $c]
2821 if {$cr < 0} {set cr
[expr {$n + 1}]}
2822 if {$lf < 0} {set lf
[expr {$n + 1}]}
2825 $w.m.t insert end
[string range
$buf $c $lf]
2826 set console_cr
($w) [$w.m.t index
{end
-1c}]
2830 $w.m.t delete
$console_cr($w) end
2831 $w.m.t insert end
"\n"
2832 $w.m.t insert end
[string range
$buf $c $cr]
2837 $w.m.t conf
-state disabled
2841 fconfigure
$fd -blocking 1
2843 if {[catch
{close
$fd}]} {
2844 if {![winfo exists
$w]} {console_init
$w}
2845 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2846 $w.ok conf
-state normal
2848 } elseif
{[winfo exists
$w]} {
2849 $w.m.s conf
-background green
-text {Success
}
2850 $w.ok conf
-state normal
2853 array
unset console_cr
$w
2854 array
unset console_data
$w
2856 uplevel
#0 $after $ok
2860 fconfigure
$fd -blocking 0
2863 ######################################################################
2867 set starting_gitk_msg
{Starting gitk... please
wait...
}
2869 proc do_gitk
{revs
} {
2870 global ui_status_value starting_gitk_msg
2878 set cmd
"sh -c \"exec $cmd\""
2882 if {[catch
{eval exec $cmd} err
]} {
2883 error_popup
"Failed to start gitk:\n\n$err"
2885 set ui_status_value
$starting_gitk_msg
2887 if {$ui_status_value eq
$starting_gitk_msg} {
2888 set ui_status_value
{Ready.
}
2895 set fd
[open
"| git count-objects -v" r
]
2896 while {[gets
$fd line
] > 0} {
2897 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
2898 set stats
($name) $value
2904 foreach p
[glob
-directory [gitdir objects pack
] \
2907 incr packed_sz
[file size
$p]
2909 if {$packed_sz > 0} {
2910 set stats
(size-pack
) [expr {$packed_sz / 1024}]
2915 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2917 label
$w.header
-text {Database Statistics
} \
2919 pack
$w.header
-side top
-fill x
2921 frame
$w.buttons
-border 1
2922 button
$w.buttons.close
-text Close \
2924 -command [list destroy
$w]
2925 button
$w.buttons.gc
-text {Compress Database
} \
2927 -command "destroy $w;do_gc"
2928 pack
$w.buttons.close
-side right
2929 pack
$w.buttons.gc
-side left
2930 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2932 frame
$w.stat
-borderwidth 1 -relief solid
2934 {count
{Number of loose objects
}}
2935 {size
{Disk space used by loose objects
} { KiB
}}
2936 {in-pack
{Number of packed objects
}}
2937 {packs
{Number of packs
}}
2938 {size-pack
{Disk space used by packed objects
} { KiB
}}
2939 {prune-packable
{Packed objects waiting
for pruning
}}
2940 {garbage
{Garbage files
}}
2942 set name
[lindex
$s 0]
2943 set label
[lindex
$s 1]
2944 if {[catch
{set value
$stats($name)}]} continue
2945 if {[llength
$s] > 2} {
2946 set value
"$value[lindex $s 2]"
2949 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
2950 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
2951 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
2953 pack
$w.stat
-pady 10 -padx 10
2955 bind $w <Visibility
> "grab $w; focus $w"
2956 bind $w <Key-Escape
> [list destroy
$w]
2957 bind $w <Key-Return
> [list destroy
$w]
2958 wm title
$w "[appname] ([reponame]): Database Statistics"
2963 set w
[new_console
{gc
} {Compressing the object database
}]
2964 console_exec
$w {git gc
}
2967 proc do_fsck_objects
{} {
2968 set w
[new_console
{fsck-objects
} \
2969 {Verifying the object database with fsck-objects
}]
2970 set cmd
[list git fsck-objects
]
2973 lappend cmd
--strict
2974 console_exec
$w $cmd
2980 global ui_comm is_quitting repo_config commit_type
2982 if {$is_quitting} return
2985 # -- Stash our current commit buffer.
2987 set save
[gitdir GITGUI_MSG
]
2988 set msg
[string trim
[$ui_comm get
0.0 end
]]
2989 regsub
-all -line {[ \r\t]+$
} $msg {} msg
2990 if {(![string match amend
* $commit_type]
2991 ||
[$ui_comm edit modified
])
2994 set fd
[open
$save w
]
2995 puts
-nonewline $fd $msg
2999 catch
{file delete
$save}
3002 # -- Stash our current window geometry into this repository.
3004 set cfg_geometry
[list
]
3005 lappend cfg_geometry
[wm geometry .
]
3006 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
3007 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
3008 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
3011 if {$cfg_geometry ne
$rc_geometry} {
3012 catch
{exec git repo-config gui.geometry
$cfg_geometry}
3019 rescan
{set ui_status_value
{Ready.
}}
3022 proc unstage_helper
{txt paths
} {
3023 global file_states current_diff_path
3025 if {![lock_index begin-update
]} return
3029 foreach path
$paths {
3030 switch
-glob -- [lindex
$file_states($path) 0] {
3034 lappend pathList
$path
3035 if {$path eq
$current_diff_path} {
3036 set after
{reshow_diff
;}
3041 if {$pathList eq
{}} {
3047 [concat
$after {set ui_status_value
{Ready.
}}]
3051 proc do_unstage_selection
{} {
3052 global current_diff_path selected_paths
3054 if {[array size selected_paths
] > 0} {
3056 {Unstaging selected files from commit
} \
3057 [array names selected_paths
]
3058 } elseif
{$current_diff_path ne
{}} {
3060 "Unstaging [short_path $current_diff_path] from commit" \
3061 [list
$current_diff_path]
3065 proc add_helper
{txt paths
} {
3066 global file_states current_diff_path
3068 if {![lock_index begin-update
]} return
3072 foreach path
$paths {
3073 switch
-glob -- [lindex
$file_states($path) 0] {
3078 lappend pathList
$path
3079 if {$path eq
$current_diff_path} {
3080 set after
{reshow_diff
;}
3085 if {$pathList eq
{}} {
3091 [concat
$after {set ui_status_value
{Ready to commit.
}}]
3095 proc do_add_selection
{} {
3096 global current_diff_path selected_paths
3098 if {[array size selected_paths
] > 0} {
3100 {Adding selected files
} \
3101 [array names selected_paths
]
3102 } elseif
{$current_diff_path ne
{}} {
3104 "Adding [short_path $current_diff_path]" \
3105 [list
$current_diff_path]
3109 proc do_add_all
{} {
3113 foreach path
[array names file_states
] {
3114 switch
-glob -- [lindex
$file_states($path) 0] {
3117 ?D
{lappend paths
$path}
3120 add_helper
{Adding all changed files
} $paths
3123 proc revert_helper
{txt paths
} {
3124 global file_states current_diff_path
3126 if {![lock_index begin-update
]} return
3130 foreach path
$paths {
3131 switch
-glob -- [lindex
$file_states($path) 0] {
3135 lappend pathList
$path
3136 if {$path eq
$current_diff_path} {
3137 set after
{reshow_diff
;}
3143 set n
[llength
$pathList]
3147 } elseif
{$n == 1} {
3148 set s
"[short_path [lindex $pathList]]"
3150 set s
"these $n files"
3153 set reply
[tk_dialog \
3155 "[appname] ([reponame])" \
3156 "Revert changes in $s?
3158 Any unadded changes will be permanently lost by the revert." \
3168 [concat
$after {set ui_status_value
{Ready.
}}]
3174 proc do_revert_selection
{} {
3175 global current_diff_path selected_paths
3177 if {[array size selected_paths
] > 0} {
3179 {Reverting selected files
} \
3180 [array names selected_paths
]
3181 } elseif
{$current_diff_path ne
{}} {
3183 "Reverting [short_path $current_diff_path]" \
3184 [list
$current_diff_path]
3188 proc do_signoff
{} {
3191 set me
[committer_ident
]
3192 if {$me eq
{}} return
3194 set sob
"Signed-off-by: $me"
3195 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
3196 if {$last ne
$sob} {
3197 $ui_comm edit separator
3199 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
3200 $ui_comm insert end
"\n"
3202 $ui_comm insert end
"\n$sob"
3203 $ui_comm edit separator
3208 proc do_select_commit_type
{} {
3209 global commit_type selected_commit_type
3211 if {$selected_commit_type eq
{new
}
3212 && [string match amend
* $commit_type]} {
3214 } elseif
{$selected_commit_type eq
{amend
}
3215 && ![string match amend
* $commit_type]} {
3218 # The amend request was rejected...
3220 if {![string match amend
* $commit_type]} {
3221 set selected_commit_type new
3231 global appvers copyright
3232 global tcl_patchLevel tk_patchLevel
3236 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3238 label
$w.header
-text "About [appname]" \
3240 pack
$w.header
-side top
-fill x
3243 button
$w.buttons.close
-text {Close
} \
3245 -command [list destroy
$w]
3246 pack
$w.buttons.close
-side right
3247 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3250 -text "[appname] - a commit creation tool for Git.
3258 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
3261 append v
"[appname] version $appvers\n"
3262 append v
"[exec git version]\n"
3264 if {$tcl_patchLevel eq
$tk_patchLevel} {
3265 append v
"Tcl/Tk version $tcl_patchLevel"
3267 append v
"Tcl version $tcl_patchLevel"
3268 append v
", Tk version $tk_patchLevel"
3279 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
3281 menu
$w.ctxm
-tearoff 0
3282 $w.ctxm add
command \
3287 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
3290 bind $w <Visibility
> "grab $w; focus $w"
3291 bind $w <Key-Escape
> "destroy $w"
3292 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
3293 wm title
$w "About [appname]"
3297 proc do_options
{} {
3298 global repo_config global_config font_descs
3299 global repo_config_new global_config_new
3301 array
unset repo_config_new
3302 array
unset global_config_new
3303 foreach name
[array names repo_config
] {
3304 set repo_config_new
($name) $repo_config($name)
3307 foreach name
[array names repo_config
] {
3309 gui.diffcontext
{continue}
3311 set repo_config_new
($name) $repo_config($name)
3313 foreach name
[array names global_config
] {
3314 set global_config_new
($name) $global_config($name)
3317 set w .options_editor
3319 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
3321 label
$w.header
-text "[appname] Options" \
3323 pack
$w.header
-side top
-fill x
3326 button
$w.buttons.restore
-text {Restore Defaults
} \
3328 -command do_restore_defaults
3329 pack
$w.buttons.restore
-side left
3330 button
$w.buttons.save
-text Save \
3333 catch {eval \[bind \[focus -displayof $w\] <FocusOut>\]}
3336 pack
$w.buttons.save
-side right
3337 button
$w.buttons.cancel
-text {Cancel
} \
3339 -command [list destroy
$w]
3340 pack
$w.buttons.cancel
-side right
-padx 5
3341 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
3343 labelframe
$w.repo
-text "[reponame] Repository" \
3345 labelframe
$w.global
-text {Global
(All Repositories
)} \
3347 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
3348 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
3351 {b pullsummary
{Show Pull Summary
}}
3352 {b trustmtime
{Trust File Modification Timestamps
}}
3353 {i diffcontext
{Number of Diff Context Lines
}}
3354 {t newbranchtemplate
{New Branch Name Template
}}
3356 set type [lindex
$option 0]
3357 set name
[lindex
$option 1]
3358 set text
[lindex
$option 2]
3359 foreach f
{repo global
} {
3362 checkbutton
$w.
$f.
$name -text $text \
3363 -variable ${f}_config_new
(gui.
$name) \
3367 pack
$w.
$f.
$name -side top
-anchor w
3371 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3372 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
3373 spinbox
$w.
$f.
$name.v \
3374 -textvariable ${f}_config_new
(gui.
$name) \
3375 -from 1 -to 99 -increment 1 \
3378 bind $w.
$f.
$name.v
<FocusIn
> {%W selection range
0 end
}
3379 pack
$w.
$f.
$name.v
-side right
-anchor e
-padx 5
3380 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3384 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
3385 text
$w.
$f.
$name.v \
3391 $w.
$f.
$name.v insert
0.0 [set ${f}_config_new
(gui.
$name)]
3392 bind $w.
$f.
$name.v
<Shift-Key-Tab
> {focus
[tk_focusPrev
%W
];break}
3393 bind $w.
$f.
$name.v
<Key-Tab
> {focus
[tk_focusNext
%W
];break}
3394 bind $w.
$f.
$name.v
<Key-Return
> break
3395 bind $w.
$f.
$name.v
<FocusIn
> "$w.$f.$name.v tag add sel 0.0 end"
3396 bind $w.
$f.
$name.v
<FocusOut
> "
3397 set ${f}_config_new(gui.$name) \
3398 \[string trim \[$w.$f.$name.v get 0.0 end\]\]
3400 pack
$w.
$f.
$name.l
-side left
-anchor w
3401 pack
$w.
$f.
$name.v
-side left
-anchor w \
3404 pack
$w.
$f.
$name -side top
-anchor w
-fill x
3410 set all_fonts
[lsort
[font families
]]
3411 foreach option
$font_descs {
3412 set name
[lindex
$option 0]
3413 set font
[lindex
$option 1]
3414 set text
[lindex
$option 2]
3416 set global_config_new
(gui.
$font^^family
) \
3417 [font configure
$font -family]
3418 set global_config_new
(gui.
$font^^size
) \
3419 [font configure
$font -size]
3421 frame
$w.global.
$name
3422 label
$w.global.
$name.l
-text "$text:" -font font_ui
3423 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
3424 eval tk_optionMenu
$w.global.
$name.family \
3425 global_config_new
(gui.
$font^^family
) \
3427 spinbox
$w.global.
$name.size \
3428 -textvariable global_config_new
(gui.
$font^^size
) \
3429 -from 2 -to 80 -increment 1 \
3432 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
3433 pack
$w.global.
$name.size
-side right
-anchor e
3434 pack
$w.global.
$name.family
-side right
-anchor e
3435 pack
$w.global.
$name -side top
-anchor w
-fill x
3438 bind $w <Visibility
> "grab $w; focus $w"
3439 bind $w <Key-Escape
> "destroy $w"
3440 wm title
$w "[appname] ([reponame]): Options"
3444 proc do_restore_defaults
{} {
3445 global font_descs default_config repo_config
3446 global repo_config_new global_config_new
3448 foreach name
[array names default_config
] {
3449 set repo_config_new
($name) $default_config($name)
3450 set global_config_new
($name) $default_config($name)
3453 foreach option
$font_descs {
3454 set name
[lindex
$option 0]
3455 set repo_config
(gui.
$name) $default_config(gui.
$name)
3459 foreach option
$font_descs {
3460 set name
[lindex
$option 0]
3461 set font
[lindex
$option 1]
3462 set global_config_new
(gui.
$font^^family
) \
3463 [font configure
$font -family]
3464 set global_config_new
(gui.
$font^^size
) \
3465 [font configure
$font -size]
3469 proc do_save_config
{w
} {
3470 if {[catch
{save_config
} err
]} {
3471 error_popup
"Failed to completely save options:\n\n$err"
3477 proc do_windows_shortcut
{} {
3481 set desktop
[exec cygpath \
3489 set fn
[tk_getSaveFile \
3491 -title "[appname] ([reponame]): Create Desktop Icon" \
3492 -initialdir $desktop \
3493 -initialfile "Git [reponame].bat"]
3497 set sh
[exec cygpath \
3501 set me
[exec cygpath \
3505 set gd
[exec cygpath \
3509 set gw
[exec cygpath \
3512 [file dirname [gitdir
]]]
3513 regsub
-all ' $me "'\\''" me
3514 regsub -all ' $gd "'\\''" gd
3515 puts $fd "@ECHO Entering $gw"
3516 puts $fd "@ECHO Starting git-gui... please wait..."
3517 puts -nonewline $fd "@\"$sh\" --login -c \""
3518 puts -nonewline $fd "GIT_DIR='$gd'"
3519 puts -nonewline $fd " '$me'"
3523 error_popup "Cannot write script:\n\n$err"
3528 proc do_macosx_app {} {
3531 set fn [tk_getSaveFile \
3533 -title "[appname] ([reponame]): Create Desktop Icon" \
3534 -initialdir [file join $env(HOME) Desktop] \
3535 -initialfile "Git [reponame].app"]
3538 set Contents [file join $fn Contents]
3539 set MacOS [file join $Contents MacOS]
3540 set exe [file join $MacOS git-gui]
3544 set fd [open [file join $Contents Info.plist] w]
3545 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
3546 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
3547 <plist version="1.0">
3549 <key>CFBundleDevelopmentRegion</key>
3550 <string>English</string>
3551 <key>CFBundleExecutable</key>
3552 <string>git-gui</string>
3553 <key>CFBundleIdentifier</key>
3554 <string>org.spearce.git-gui</string>
3555 <key>CFBundleInfoDictionaryVersion</key>
3556 <string>6.0</string>
3557 <key>CFBundlePackageType</key>
3558 <string>APPL</string>
3559 <key>CFBundleSignature</key>
3560 <string>????</string>
3561 <key>CFBundleVersion</key>
3562 <string>1.0</string>
3563 <key>NSPrincipalClass</key>
3564 <string>NSApplication</string>
3569 set fd [open $exe w]
3570 set gd [file normalize [gitdir]]
3571 set ep [file normalize [exec git --exec-path]]
3572 regsub -all ' $gd "'\\''" gd
3573 regsub
-all ' $ep "'\\''" ep
3574 puts $fd "#!/bin/sh"
3575 foreach name
[array names env
] {
3576 if {[string match GIT_
* $name]} {
3577 regsub
-all ' $env($name) "'\\''" v
3578 puts $fd "export $name='$v'"
3581 puts $fd "export PATH
='$ep':\
$PATH"
3582 puts $fd "export GIT_DIR
='$gd'"
3583 puts $fd "exec [file normalize
$argv0]"
3586 file attributes $exe -permissions u+x,g+x,o+x
3588 error_popup "Cannot
write icon
:\n\n$err"
3593 proc toggle_or_diff {w x y} {
3594 global file_states file_lists current_diff_path ui_index ui_workdir
3595 global last_clicked selected_paths
3597 set pos [split [$w index @$x,$y] .]
3598 set lno [lindex $pos 0]
3599 set col [lindex $pos 1]
3600 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3606 set last_clicked [list $w $lno]
3607 array unset selected_paths
3608 $ui_index tag remove in_sel 0.0 end
3609 $ui_workdir tag remove in_sel 0.0 end
3612 if {$current_diff_path eq $path} {
3613 set after {reshow_diff;}
3617 if {$w eq $ui_index} {
3619 "Unstaging
[short_path
$path] from commit
" \
3621 [concat $after {set ui_status_value {Ready.}}]
3622 } elseif {$w eq $ui_workdir} {
3624 "Adding
[short_path
$path]" \
3626 [concat $after {set ui_status_value {Ready.}}]
3629 show_diff $path $w $lno
3633 proc add_one_to_selection {w x y} {
3634 global file_lists last_clicked selected_paths
3636 set lno [lindex [split [$w index @$x,$y] .] 0]
3637 set path [lindex $file_lists($w) [expr {$lno - 1}]]
3643 if {$last_clicked ne {}
3644 && [lindex $last_clicked 0] ne $w} {
3645 array unset selected_paths
3646 [lindex $last_clicked 0] tag remove in_sel 0.0 end
3649 set last_clicked [list $w $lno]
3650 if {[catch {set in_sel $selected_paths($path)}]} {
3654 unset selected_paths($path)
3655 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
3657 set selected_paths($path) 1
3658 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
3662 proc add_range_to_selection {w x y} {
3663 global file_lists last_clicked selected_paths
3665 if {[lindex $last_clicked 0] ne $w} {
3666 toggle_or_diff $w $x $y
3670 set lno [lindex [split [$w index @$x,$y] .] 0]
3671 set lc [lindex $last_clicked 1]
3680 foreach path [lrange $file_lists($w) \
3681 [expr {$begin - 1}] \
3682 [expr {$end - 1}]] {
3683 set selected_paths($path) 1
3685 $w tag add in_sel $begin.0 [expr {$end + 1}].0
3688 ######################################################################
3692 set cursor_ptr arrow
3693 font create font_diff -family Courier -size 10
3697 eval font configure font_ui [font actual [.dummy cget -font]]
3701 font create font_uibold
3702 font create font_diffbold
3707 } elseif {[is_MacOSX]} {
3715 proc apply_config {} {
3716 global repo_config font_descs
3718 foreach option $font_descs {
3719 set name [lindex $option 0]
3720 set font [lindex $option 1]
3722 foreach {cn cv} $repo_config(gui.$name) {
3723 font configure $font $cn $cv
3726 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
3728 foreach {cn cv} [font configure $font] {
3729 font configure ${font}bold $cn $cv
3731 font configure ${font}bold -weight bold
3735 set default_config(gui.trustmtime) false
3736 set default_config(gui.pullsummary) true
3737 set default_config(gui.diffcontext) 5
3738 set default_config(gui.newbranchtemplate) {}
3739 set default_config(gui.fontui) [font configure font_ui]
3740 set default_config(gui.fontdiff) [font configure font_diff]
3742 {fontui font_ui {Main Font}}
3743 {fontdiff font_diff {Diff/Console Font}}
3748 ######################################################################
3754 menu .mbar -tearoff 0
3755 .mbar add cascade -label Repository -menu .mbar.repository
3756 .mbar add cascade -label Edit -menu .mbar.edit
3757 if {!$single_commit} {
3758 .mbar add cascade -label Branch -menu .mbar.branch
3760 .mbar add cascade -label Commit -menu .mbar.commit
3761 if {!$single_commit} {
3762 .mbar add cascade -label Fetch -menu .mbar.fetch
3763 .mbar add cascade -label Pull -menu .mbar.pull
3764 .mbar add cascade -label Push -menu .mbar.push
3766 . configure -menu .mbar
3768 # -- Repository Menu
3770 menu .mbar.repository
3771 .mbar.repository add command \
3772 -label {Visualize Current Branch} \
3773 -command {do_gitk {}} \
3775 .mbar.repository add command \
3776 -label {Visualize All Branches} \
3777 -command {do_gitk {--all}} \
3779 .mbar.repository add separator
3781 if {!$single_commit} {
3782 .mbar.repository add command -label {Database Statistics} \
3786 .mbar.repository add command -label {Compress Database} \
3790 .mbar.repository add command -label {Verify Database} \
3791 -command do_fsck_objects \
3794 .mbar.repository add separator
3797 .mbar.repository add command \
3798 -label {Create Desktop Icon} \
3799 -command do_windows_shortcut \
3801 } elseif {[is_MacOSX]} {
3802 .mbar.repository add command \
3803 -label {Create Desktop Icon} \
3804 -command do_macosx_app \
3809 .mbar.repository add command -label Quit \
3811 -accelerator $M1T-Q \
3817 .mbar.edit add command -label Undo \
3818 -command {catch {[focus] edit undo}} \
3819 -accelerator $M1T-Z \
3821 .mbar.edit add command -label Redo \
3822 -command {catch {[focus] edit redo}} \
3823 -accelerator $M1T-Y \
3825 .mbar.edit add separator
3826 .mbar.edit add command -label Cut \
3827 -command {catch {tk_textCut [focus]}} \
3828 -accelerator $M1T-X \
3830 .mbar.edit add command -label Copy \
3831 -command {catch {tk_textCopy [focus]}} \
3832 -accelerator $M1T-C \
3834 .mbar.edit add command -label Paste \
3835 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3836 -accelerator $M1T-V \
3838 .mbar.edit add command -label Delete \
3839 -command {catch {[focus] delete sel.first sel.last}} \
3842 .mbar.edit add separator
3843 .mbar.edit add command -label {Select All} \
3844 -command {catch {[focus] tag add sel 0.0 end}} \
3845 -accelerator $M1T-A \
3850 if {!$single_commit} {
3853 .mbar.branch add command -label {Create...} \
3854 -command do_create_branch \
3855 -accelerator $M1T-N \
3857 lappend disable_on_lock [list .mbar.branch entryconf \
3858 [.mbar.branch index last] -state]
3860 .mbar.branch add command -label {Delete...} \
3861 -command do_delete_branch \
3863 lappend disable_on_lock [list .mbar.branch entryconf \
3864 [.mbar.branch index last] -state]
3871 .mbar.commit add radiobutton \
3872 -label {New Commit} \
3873 -command do_select_commit_type \
3874 -variable selected_commit_type \
3877 lappend disable_on_lock \
3878 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3880 .mbar.commit add radiobutton \
3881 -label {Amend Last Commit} \
3882 -command do_select_commit_type \
3883 -variable selected_commit_type \
3886 lappend disable_on_lock \
3887 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3889 .mbar.commit add separator
3891 .mbar.commit add command -label Rescan \
3892 -command do_rescan \
3895 lappend disable_on_lock \
3896 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3898 .mbar.commit add command -label {Add To Commit} \
3899 -command do_add_selection \
3901 lappend disable_on_lock \
3902 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3904 .mbar.commit add command -label {Add All To Commit} \
3905 -command do_add_all \
3906 -accelerator $M1T-I \
3908 lappend disable_on_lock \
3909 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3911 .mbar.commit add command -label {Unstage From Commit} \
3912 -command do_unstage_selection \
3914 lappend disable_on_lock \
3915 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3917 .mbar.commit add command -label {Revert Changes} \
3918 -command do_revert_selection \
3920 lappend disable_on_lock \
3921 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3923 .mbar.commit add separator
3925 .mbar.commit add command -label {Sign Off} \
3926 -command do_signoff \
3927 -accelerator $M1T-S \
3930 .mbar.commit add command -label Commit \
3931 -command do_commit \
3932 -accelerator $M1T-Return \
3934 lappend disable_on_lock \
3935 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3937 # -- Transport menus
3939 if {!$single_commit} {
3946 # -- Apple Menu (Mac OS X only)
3948 .mbar add cascade -label Apple -menu .mbar.apple
3951 .mbar.apple add command -label "About
[appname
]" \
3954 .mbar.apple add command -label "[appname
] Options...
" \
3955 -command do_options \
3960 .mbar.edit add separator
3961 .mbar.edit add command -label {Options...} \
3962 -command do_options \
3967 if {[file exists /usr/local/miga/lib/gui-miga]
3968 && [file exists .pvcsrc]} {
3970 global ui_status_value
3971 if {![lock_index update]} return
3972 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3973 set miga_fd [open "|
$cmd" r]
3974 fconfigure $miga_fd -blocking 0
3975 fileevent $miga_fd readable [list miga_done $miga_fd]
3976 set ui_status_value {Running miga...}
3978 proc miga_done {fd} {
3983 rescan [list set ui_status_value {Ready.}]
3986 .mbar add cascade -label Tools -menu .mbar.tools
3988 .mbar.tools add command -label "Migrate
" \
3991 lappend disable_on_lock \
3992 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3997 .mbar add cascade -label Help -menu .mbar.help
4000 .mbar.help add command -label "About
[appname
]" \
4012 -text {Current Branch:} \
4017 -textvariable current_branch \
4021 pack .branch.l1 -side left
4022 pack .branch.cb -side left -fill x
4023 pack .branch -side top -fill x
4025 # -- Main Window Layout
4027 panedwindow .vpane -orient vertical
4028 panedwindow .vpane.files -orient horizontal
4029 .vpane add .vpane.files -sticky nsew -height 100 -width 200
4030 pack .vpane -anchor n -side top -fill both -expand 1
4032 # -- Index File List
4034 frame .vpane.files.index -height 100 -width 200
4035 label .vpane.files.index.title -text {Changes To Be Committed} \
4038 text $ui_index -background white -borderwidth 0 \
4039 -width 20 -height 10 \
4042 -cursor $cursor_ptr \
4043 -xscrollcommand {.vpane.files.index.sx set} \
4044 -yscrollcommand {.vpane.files.index.sy set} \
4046 scrollbar .vpane.files.index.sx -orient h -command [list $ui_index xview]
4047 scrollbar .vpane.files.index.sy -orient v -command [list $ui_index yview]
4048 pack .vpane.files.index.title -side top -fill x
4049 pack .vpane.files.index.sx -side bottom -fill x
4050 pack .vpane.files.index.sy -side right -fill y
4051 pack $ui_index -side left -fill both -expand 1
4052 .vpane.files add .vpane.files.index -sticky nsew
4054 # -- Working Directory File List
4056 frame .vpane.files.workdir -height 100 -width 200
4057 label .vpane.files.workdir.title -text {Changed But Not Updated} \
4060 text $ui_workdir -background white -borderwidth 0 \
4061 -width 20 -height 10 \
4064 -cursor $cursor_ptr \
4065 -xscrollcommand {.vpane.files.workdir.sx set} \
4066 -yscrollcommand {.vpane.files.workdir.sy set} \
4068 scrollbar .vpane.files.workdir.sx -orient h -command [list $ui_workdir xview]
4069 scrollbar .vpane.files.workdir.sy -orient v -command [list $ui_workdir yview]
4070 pack .vpane.files.workdir.title -side top -fill x
4071 pack .vpane.files.workdir.sx -side bottom -fill x
4072 pack .vpane.files.workdir.sy -side right -fill y
4073 pack $ui_workdir -side left -fill both -expand 1
4074 .vpane.files add .vpane.files.workdir -sticky nsew
4076 foreach i [list $ui_index $ui_workdir] {
4077 $i tag conf in_diff -font font_uibold
4078 $i tag conf in_sel \
4079 -background [$i cget -foreground] \
4080 -foreground [$i cget -background]
4084 # -- Diff and Commit Area
4086 frame .vpane.lower -height 300 -width 400
4087 frame .vpane.lower.commarea
4088 frame .vpane.lower.diff -relief sunken -borderwidth 1
4089 pack .vpane.lower.commarea -side top -fill x
4090 pack .vpane.lower.diff -side bottom -fill both -expand 1
4091 .vpane add .vpane.lower -sticky nsew
4093 # -- Commit Area Buttons
4095 frame .vpane.lower.commarea.buttons
4096 label .vpane.lower.commarea.buttons.l -text {} \
4100 pack .vpane.lower.commarea.buttons.l -side top -fill x
4101 pack .vpane.lower.commarea.buttons -side left -fill y
4103 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
4104 -command do_rescan \
4106 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
4107 lappend disable_on_lock \
4108 {.vpane.lower.commarea.buttons.rescan conf -state}
4110 button .vpane.lower.commarea.buttons.incall -text {Add All} \
4111 -command do_add_all \
4113 pack .vpane.lower.commarea.buttons.incall -side top -fill x
4114 lappend disable_on_lock \
4115 {.vpane.lower.commarea.buttons.incall conf -state}
4117 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
4118 -command do_signoff \
4120 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
4122 button .vpane.lower.commarea.buttons.commit -text {Commit} \
4123 -command do_commit \
4125 pack .vpane.lower.commarea.buttons.commit -side top -fill x
4126 lappend disable_on_lock \
4127 {.vpane.lower.commarea.buttons.commit conf -state}
4129 # -- Commit Message Buffer
4131 frame .vpane.lower.commarea.buffer
4132 frame .vpane.lower.commarea.buffer.header
4133 set ui_comm .vpane.lower.commarea.buffer.t
4134 set ui_coml .vpane.lower.commarea.buffer.header.l
4135 radiobutton .vpane.lower.commarea.buffer.header.new \
4136 -text {New Commit} \
4137 -command do_select_commit_type \
4138 -variable selected_commit_type \
4141 lappend disable_on_lock \
4142 [list .vpane.lower.commarea.buffer.header.new conf -state]
4143 radiobutton .vpane.lower.commarea.buffer.header.amend \
4144 -text {Amend Last Commit} \
4145 -command do_select_commit_type \
4146 -variable selected_commit_type \
4149 lappend disable_on_lock \
4150 [list .vpane.lower.commarea.buffer.header.amend conf -state]
4155 proc trace_commit_type {varname args} {
4156 global ui_coml commit_type
4157 switch -glob -- $commit_type {
4158 initial {set txt {Initial Commit Message:}}
4159 amend {set txt {Amended Commit Message:}}
4160 amend-initial {set txt {Amended Initial Commit Message:}}
4161 amend-merge {set txt {Amended Merge Commit Message:}}
4162 merge {set txt {Merge Commit Message:}}
4163 * {set txt {Commit Message:}}
4165 $ui_coml conf -text $txt
4167 trace add variable commit_type write trace_commit_type
4168 pack $ui_coml -side left -fill x
4169 pack .vpane.lower.commarea.buffer.header.amend -side right
4170 pack .vpane.lower.commarea.buffer.header.new -side right
4172 text $ui_comm -background white -borderwidth 1 \
4175 -autoseparators true \
4177 -width 75 -height 9 -wrap none \
4179 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
4180 scrollbar .vpane.lower.commarea.buffer.sby \
4181 -command [list $ui_comm yview]
4182 pack .vpane.lower.commarea.buffer.header -side top -fill x
4183 pack .vpane.lower.commarea.buffer.sby -side right -fill y
4184 pack $ui_comm -side left -fill y
4185 pack .vpane.lower.commarea.buffer -side left -fill y
4187 # -- Commit Message Buffer Context Menu
4189 set ctxm .vpane.lower.commarea.buffer.ctxm
4190 menu $ctxm -tearoff 0
4194 -command {tk_textCut $ui_comm}
4198 -command {tk_textCopy $ui_comm}
4202 -command {tk_textPaste $ui_comm}
4206 -command {$ui_comm delete sel.first sel.last}
4209 -label {Select All} \
4211 -command {focus $ui_comm;$ui_comm tag add sel 0.0 end}
4216 $ui_comm tag add sel 0.0 end
4217 tk_textCopy $ui_comm
4218 $ui_comm tag remove sel 0.0 end
4225 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
4229 set current_diff_path {}
4230 set current_diff_side {}
4231 set diff_actions [list]
4232 proc trace_current_diff_path {varname args} {
4233 global current_diff_path diff_actions file_states
4234 if {$current_diff_path eq {}} {
4240 set p $current_diff_path
4241 set s [mapdesc [lindex $file_states($p) 0] $p]
4243 set p [escape_path $p]
4247 .vpane.lower.diff.header.status configure -text $s
4248 .vpane.lower.diff.header.file configure -text $f
4249 .vpane.lower.diff.header.path configure -text $p
4250 foreach w $diff_actions {
4254 trace add variable current_diff_path write trace_current_diff_path
4256 frame .vpane.lower.diff.header -background orange
4257 label .vpane.lower.diff.header.status \
4258 -background orange \
4259 -width $max_status_desc \
4263 label .vpane.lower.diff.header.file \
4264 -background orange \
4268 label .vpane.lower.diff.header.path \
4269 -background orange \
4273 pack .vpane.lower.diff.header.status -side left
4274 pack .vpane.lower.diff.header.file -side left
4275 pack .vpane.lower.diff.header.path -fill x
4276 set ctxm .vpane.lower.diff.header.ctxm
4277 menu $ctxm -tearoff 0
4286 -- $current_diff_path
4288 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4289 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
4293 frame .vpane.lower.diff.body
4294 set ui_diff .vpane.lower.diff.body.t
4295 text $ui_diff -background white -borderwidth 0 \
4296 -width 80 -height 15 -wrap none \
4298 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
4299 -yscrollcommand {.vpane.lower.diff.body.sby set} \
4301 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
4302 -command [list $ui_diff xview]
4303 scrollbar .vpane.lower.diff.body.sby -orient vertical \
4304 -command [list $ui_diff yview]
4305 pack .vpane.lower.diff.body.sbx -side bottom -fill x
4306 pack .vpane.lower.diff.body.sby -side right -fill y
4307 pack $ui_diff -side left -fill both -expand 1
4308 pack .vpane.lower.diff.header -side top -fill x
4309 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
4311 $ui_diff tag conf d_cr -elide true
4312 $ui_diff tag conf d_@ -foreground blue -font font_diffbold
4313 $ui_diff tag conf d_+ -foreground {#00a000}
4314 $ui_diff tag conf d_- -foreground red
4316 $ui_diff tag conf d_++ -foreground {#00a000}
4317 $ui_diff tag conf d_-- -foreground red
4318 $ui_diff tag conf d_+s \
4319 -foreground {#00a000} \
4320 -background {#e2effa}
4321 $ui_diff tag conf d_-s \
4323 -background {#e2effa}
4324 $ui_diff tag conf d_s+ \
4325 -foreground {#00a000} \
4327 $ui_diff tag conf d_s- \
4331 $ui_diff tag conf d<<<<<<< \
4332 -foreground orange \
4334 $ui_diff tag conf d======= \
4335 -foreground orange \
4337 $ui_diff tag conf d>>>>>>> \
4338 -foreground orange \
4341 $ui_diff tag raise sel
4343 # -- Diff Body Context Menu
4345 set ctxm .vpane.lower.diff.body.ctxm
4346 menu $ctxm -tearoff 0
4350 -command reshow_diff
4351 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4355 -command {tk_textCopy $ui_diff}
4356 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4358 -label {Select All} \
4360 -command {focus $ui_diff;$ui_diff tag add sel 0.0 end}
4361 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4366 $ui_diff tag add sel 0.0 end
4367 tk_textCopy $ui_diff
4368 $ui_diff tag remove sel 0.0 end
4370 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4373 -label {Apply/Reverse Hunk} \
4375 -command {apply_hunk $cursorX $cursorY}
4376 set ui_diff_applyhunk [$ctxm index last]
4377 lappend diff_actions [list $ctxm entryconf $ui_diff_applyhunk -state]
4380 -label {Decrease Font Size} \
4382 -command {incr_font_size font_diff -1}
4383 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4385 -label {Increase Font Size} \
4387 -command {incr_font_size font_diff 1}
4388 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4391 -label {Show Less Context} \
4393 -command {if {$repo_config(gui.diffcontext) >= 2} {
4394 incr repo_config(gui.diffcontext) -1
4397 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4399 -label {Show More Context} \
4402 incr repo_config(gui.diffcontext)
4405 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
4407 $ctxm add command -label {Options...} \
4410 bind_button3 $ui_diff "
4413 if {\
$ui_index eq \
$current_diff_side} {
4414 $ctxm entryconf
$ui_diff_applyhunk -label {Unstage Hunk From Commit
}
4416 $ctxm entryconf
$ui_diff_applyhunk -label {Stage Hunk For Commit
}
4418 tk_popup
$ctxm %X
%Y
4420 unset ui_diff_applyhunk
4424 set ui_status_value {Initializing...}
4425 label .status -textvariable ui_status_value \
4431 pack .status -anchor w -side bottom -fill x
4436 set gm $repo_config(gui.geometry)
4437 wm geometry . [lindex $gm 0]
4438 .vpane sash place 0 \
4439 [lindex [.vpane sash coord 0] 0] \
4441 .vpane.files sash place 0 \
4443 [lindex [.vpane.files sash coord 0] 1]
4449 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
4450 bind $ui_comm <$M1B-Key-i> {do_add_all;break}
4451 bind $ui_comm <$M1B-Key-I> {do_add_all;break}
4452 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
4453 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
4454 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
4455 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
4456 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
4457 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
4458 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4459 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4461 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
4462 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
4463 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
4464 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
4465 bind $ui_diff <$M1B-Key-v> {break}
4466 bind $ui_diff <$M1B-Key-V> {break}
4467 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
4468 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
4469 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
4470 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
4471 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
4472 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
4473 bind $ui_diff <Button-1> {focus %W}
4475 if {!$single_commit} {
4476 bind . <$M1B-Key-n> do_create_branch
4477 bind . <$M1B-Key-N> do_create_branch
4480 bind . <Destroy> do_quit
4481 bind all <Key-F5> do_rescan
4482 bind all <$M1B-Key-r> do_rescan
4483 bind all <$M1B-Key-R> do_rescan
4484 bind . <$M1B-Key-s> do_signoff
4485 bind . <$M1B-Key-S> do_signoff
4486 bind . <$M1B-Key-i> do_add_all
4487 bind . <$M1B-Key-I> do_add_all
4488 bind . <$M1B-Key-Return> do_commit
4489 bind all <$M1B-Key-q> do_quit
4490 bind all <$M1B-Key-Q> do_quit
4491 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
4492 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
4493 foreach i [list $ui_index $ui_workdir] {
4494 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
4495 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
4496 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
4500 set file_lists($ui_index) [list]
4501 set file_lists($ui_workdir) [list]
4505 set MERGE_HEAD [list]
4508 set current_branch {}
4509 set current_diff_path {}
4510 set selected_commit_type new
4512 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
4513 focus -force $ui_comm
4515 # -- Warn the user about environmental problems. Cygwin's Tcl
4516 # does *not* pass its env array onto any processes it spawns.
4517 # This means that git processes get none of our environment.
4522 set msg "Possible environment issues exist.
4524 The following environment variables are probably
4525 going to be ignored by any Git subprocess run
4529 foreach name [array names env] {
4530 switch -regexp -- $name {
4531 {^GIT_INDEX_FILE$} -
4532 {^GIT_OBJECT_DIRECTORY$} -
4533 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
4535 {^GIT_EXTERNAL_DIFF$} -
4539 {^GIT_CONFIG_LOCAL$} -
4540 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
4541 append msg " - $name\n"
4544 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
4545 append msg " - $name\n"
4547 set suggest_user $name
4551 if {$ignored_env > 0} {
4553 This is due to a known issue with the
4554 Tcl binary distributed by Cygwin.
"
4556 if {$suggest_user ne {}} {
4559 A good replacement
for $suggest_user
4560 is placing values
for the user.name and
4561 user.email settings into your personal
4567 unset ignored_env msg suggest_user name
4570 # -- Only initialize complex UI if we are going to stay running.
4572 if {!$single_commit} {
4576 populate_branch_menu
4577 populate_fetch_menu .mbar.fetch
4578 populate_pull_menu .mbar.pull
4579 populate_push_menu .mbar.push
4582 # -- Only suggest a gc run if we are going to stay running.
4584 if {!$single_commit} {
4585 set object_limit 2000
4586 if {[is_Windows]} {set object_limit 200}
4587 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
4588 if {$objects_current >= $object_limit} {
4590 "This repository currently has
$objects_current loose objects.
4592 To maintain optimal performance it is strongly
4593 recommended that you
compress the database
4594 when
more than
$object_limit loose objects exist.
4596 Compress the database now?
"] eq yes} {
4600 unset object_limit _junk objects_current
4603 lock_index begin-read