2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GITGUI_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, et. al.
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
}
26 ######################################################################
30 set _appname
[lindex
[file split $argv0] end
]
46 return [eval [concat
[list
file join $_gitdir] $args]]
51 if {$_gitexec eq
{}} {
52 if {[catch
{set _gitexec
[git
--exec-path]} err
]} {
53 error
"Git not installed?\n\n$err"
59 return [eval [concat
[list
file join $_gitexec] $args]]
68 global tcl_platform tk_library
69 if {[tk windowingsystem
] eq
{aqua
}} {
77 if {$tcl_platform(platform
) eq
{windows
}} {
84 global tcl_platform _iscygwin
85 if {$_iscygwin eq
{}} {
86 if {$tcl_platform(platform
) eq
{windows
}} {
87 if {[catch
{set p
[exec cygpath
--windir]} err
]} {
99 proc is_enabled
{option
} {
100 global enabled_options
101 if {[catch
{set on
$enabled_options($option)}]} {return 0}
105 proc enable_option
{option
} {
106 global enabled_options
107 set enabled_options
($option) 1
110 proc disable_option
{option
} {
111 global enabled_options
112 set enabled_options
($option) 0
115 ######################################################################
119 proc is_many_config
{name
} {
120 switch
-glob -- $name {
129 proc is_config_true
{name
} {
131 if {[catch
{set v
$repo_config($name)}]} {
133 } elseif
{$v eq
{true
} ||
$v eq
{1} ||
$v eq
{yes}} {
140 proc load_config
{include_global
} {
141 global repo_config global_config default_config
143 array
unset global_config
144 if {$include_global} {
146 set fd_rc
[open
"| git config --global --list" r
]
147 while {[gets
$fd_rc line
] >= 0} {
148 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
149 if {[is_many_config
$name]} {
150 lappend global_config
($name) $value
152 set global_config
($name) $value
160 array
unset repo_config
162 set fd_rc
[open
"| git config --list" r
]
163 while {[gets
$fd_rc line
] >= 0} {
164 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
165 if {[is_many_config
$name]} {
166 lappend repo_config
($name) $value
168 set repo_config
($name) $value
175 foreach name
[array names default_config
] {
176 if {[catch
{set v
$global_config($name)}]} {
177 set global_config
($name) $default_config($name)
179 if {[catch
{set v
$repo_config($name)}]} {
180 set repo_config
($name) $default_config($name)
185 proc save_config
{} {
186 global default_config font_descs
187 global repo_config global_config
188 global repo_config_new global_config_new
190 foreach option
$font_descs {
191 set name
[lindex
$option 0]
192 set font
[lindex
$option 1]
193 font configure
$font \
194 -family $global_config_new(gui.
$font^^family
) \
195 -size $global_config_new(gui.
$font^^size
)
196 font configure
${font}bold \
197 -family $global_config_new(gui.
$font^^family
) \
198 -size $global_config_new(gui.
$font^^size
)
199 set global_config_new
(gui.
$name) [font configure
$font]
200 unset global_config_new
(gui.
$font^^family
)
201 unset global_config_new
(gui.
$font^^size
)
204 foreach name
[array names default_config
] {
205 set value
$global_config_new($name)
206 if {$value ne
$global_config($name)} {
207 if {$value eq
$default_config($name)} {
208 catch
{git config
--global --unset $name}
210 regsub
-all "\[{}\]" $value {"} value
211 git config --global $name $value
213 set global_config($name) $value
214 if {$value eq $repo_config($name)} {
215 catch {git config --unset $name}
216 set repo_config($name) $value
221 foreach name [array names default_config] {
222 set value $repo_config_new($name)
223 if {$value ne $repo_config($name)} {
224 if {$value eq $global_config($name)} {
225 catch {git config --unset $name}
227 regsub -all "\
[{}\
]" $value {"} value
228 git config
$name $value
230 set repo_config
($name) $value
235 ######################################################################
240 return [eval exec git
$args]
243 proc error_popup
{msg
} {
245 if {[reponame
] ne
{}} {
246 append title
" ([reponame])"
248 set cmd
[list tk_messageBox \
251 -title "$title: error" \
253 if {[winfo ismapped .
]} {
254 lappend cmd
-parent .
259 proc warn_popup
{msg
} {
261 if {[reponame
] ne
{}} {
262 append title
" ([reponame])"
264 set cmd
[list tk_messageBox \
267 -title "$title: warning" \
269 if {[winfo ismapped .
]} {
270 lappend cmd
-parent .
275 proc info_popup
{msg
{parent .
}} {
277 if {[reponame
] ne
{}} {
278 append title
" ([reponame])"
288 proc ask_popup
{msg
} {
290 if {[reponame
] ne
{}} {
291 append title
" ([reponame])"
293 return [tk_messageBox \
301 ######################################################################
308 if {[catch
{set v
[git
--version]} err
]} {
309 catch
{wm withdraw .
}
310 error_popup
"Cannot determine Git version:
314 [appname] requires Git $req_maj.$req_min or later."
317 if {[regexp
{^git version
(\d
+)\.
(\d
+)} $v _junk act_maj act_min
]} {
318 if {$act_maj < $req_maj
319 ||
($act_maj == $req_maj && $act_min < $req_min)} {
320 catch
{wm withdraw .
}
321 error_popup
"[appname] requires Git $req_maj.$req_min or later.
327 catch
{wm withdraw .
}
328 error_popup
"Cannot parse Git version string:\n\n$v"
331 unset -nocomplain v _junk act_maj act_min req_maj req_min
333 ######################################################################
337 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
338 && [catch
{set _gitdir
[git rev-parse
--git-dir]} err
]} {
339 catch
{wm withdraw .
}
340 error_popup
"Cannot find the git directory:\n\n$err"
343 if {![file isdirectory
$_gitdir] && [is_Cygwin
]} {
344 catch
{set _gitdir
[exec cygpath
--unix $_gitdir]}
346 if {![file isdirectory
$_gitdir]} {
347 catch
{wm withdraw .
}
348 error_popup
"Git directory not found:\n\n$_gitdir"
351 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
352 catch
{wm withdraw .
}
353 error_popup
"Cannot use funny .git directory:\n\n$_gitdir"
356 if {[catch
{cd [file dirname $_gitdir]} err
]} {
357 catch
{wm withdraw .
}
358 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
361 set _reponame
[lindex
[file split \
362 [file normalize
[file dirname $_gitdir]]] \
365 ######################################################################
369 set current_diff_path
{}
370 set current_diff_side
{}
371 set diff_actions
[list
]
372 set ui_status_value
{Initializing...
}
376 set MERGE_HEAD
[list
]
379 set current_branch
{}
380 set current_diff_path
{}
381 set selected_commit_type new
383 ######################################################################
391 set disable_on_lock
[list
]
392 set index_lock_type none
394 proc lock_index
{type} {
395 global index_lock_type disable_on_lock
397 if {$index_lock_type eq
{none
}} {
398 set index_lock_type
$type
399 foreach w
$disable_on_lock {
400 uplevel
#0 $w disabled
403 } elseif
{$index_lock_type eq
"begin-$type"} {
404 set index_lock_type
$type
410 proc unlock_index
{} {
411 global index_lock_type disable_on_lock
413 set index_lock_type none
414 foreach w
$disable_on_lock {
419 ######################################################################
423 proc repository_state
{ctvar hdvar mhvar
} {
424 global current_branch
425 upvar
$ctvar ct
$hdvar hd
$mhvar mh
429 if {[catch
{set current_branch
[git symbolic-ref HEAD
]}]} {
430 set current_branch
{}
432 regsub ^refs
/((heads|tags|remotes
)/)? \
438 if {[catch
{set hd
[git rev-parse
--verify HEAD
]}]} {
444 set merge_head
[gitdir MERGE_HEAD
]
445 if {[file exists
$merge_head]} {
447 set fd_mh
[open
$merge_head r
]
448 while {[gets
$fd_mh line
] >= 0} {
459 global PARENT empty_tree
461 set p
[lindex
$PARENT 0]
465 if {$empty_tree eq
{}} {
466 set empty_tree
[git mktree
<< {}]
471 proc rescan
{after
{honor_trustmtime
1}} {
472 global HEAD PARENT MERGE_HEAD commit_type
473 global ui_index ui_workdir ui_status_value ui_comm
474 global rescan_active file_states
477 if {$rescan_active > 0 ||
![lock_index
read]} return
479 repository_state newType newHEAD newMERGE_HEAD
480 if {[string match amend
* $commit_type]
481 && $newType eq
{normal
}
482 && $newHEAD eq
$HEAD} {
486 set MERGE_HEAD
$newMERGE_HEAD
487 set commit_type
$newType
490 array
unset file_states
492 if {![$ui_comm edit modified
]
493 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
494 if {[load_message GITGUI_MSG
]} {
495 } elseif
{[load_message MERGE_MSG
]} {
496 } elseif
{[load_message SQUASH_MSG
]} {
499 $ui_comm edit modified false
502 if {[is_enabled branch
]} {
507 if {$honor_trustmtime && $repo_config(gui.trustmtime
) eq
{true
}} {
508 rescan_stage2
{} $after
511 set ui_status_value
{Refreshing
file status...
}
512 set cmd
[list git update-index
]
514 lappend cmd
--unmerged
515 lappend cmd
--ignore-missing
516 lappend cmd
--refresh
517 set fd_rf
[open
"| $cmd" r
]
518 fconfigure
$fd_rf -blocking 0 -translation binary
519 fileevent
$fd_rf readable \
520 [list rescan_stage2
$fd_rf $after]
524 proc rescan_stage2
{fd after
} {
525 global ui_status_value
526 global rescan_active buf_rdi buf_rdf buf_rlo
530 if {![eof
$fd]} return
534 set ls_others
[list | git ls-files
--others -z \
535 --exclude-per-directory=.gitignore
]
536 set info_exclude
[gitdir info exclude
]
537 if {[file readable
$info_exclude]} {
538 lappend ls_others
"--exclude-from=$info_exclude"
546 set ui_status_value
{Scanning
for modified files ...
}
547 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
548 set fd_df
[open
"| git diff-files -z" r
]
549 set fd_lo
[open
$ls_others r
]
551 fconfigure
$fd_di -blocking 0 -translation binary
-encoding binary
552 fconfigure
$fd_df -blocking 0 -translation binary
-encoding binary
553 fconfigure
$fd_lo -blocking 0 -translation binary
-encoding binary
554 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
555 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
556 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
559 proc load_message
{file} {
563 if {[file isfile
$f]} {
564 if {[catch
{set fd
[open
$f r
]}]} {
567 set content
[string trim
[read $fd]]
569 regsub
-all -line {[ \r\t]+$
} $content {} content
570 $ui_comm delete
0.0 end
571 $ui_comm insert end
$content
577 proc read_diff_index
{fd after
} {
580 append buf_rdi
[read $fd]
582 set n
[string length
$buf_rdi]
584 set z1
[string first
"\0" $buf_rdi $c]
587 set z2
[string first
"\0" $buf_rdi $z1]
591 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
592 set p
[string range
$buf_rdi $z1 [expr {$z2 - 1}]]
594 [encoding convertfrom
$p] \
596 [list
[lindex
$i 0] [lindex
$i 2]] \
602 set buf_rdi
[string range
$buf_rdi $c end
]
607 rescan_done
$fd buf_rdi
$after
610 proc read_diff_files
{fd after
} {
613 append buf_rdf
[read $fd]
615 set n
[string length
$buf_rdf]
617 set z1
[string first
"\0" $buf_rdf $c]
620 set z2
[string first
"\0" $buf_rdf $z1]
624 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
625 set p
[string range
$buf_rdf $z1 [expr {$z2 - 1}]]
627 [encoding convertfrom
$p] \
630 [list
[lindex
$i 0] [lindex
$i 2]]
635 set buf_rdf
[string range
$buf_rdf $c end
]
640 rescan_done
$fd buf_rdf
$after
643 proc read_ls_others
{fd after
} {
646 append buf_rlo
[read $fd]
647 set pck
[split $buf_rlo "\0"]
648 set buf_rlo
[lindex
$pck end
]
649 foreach p
[lrange
$pck 0 end-1
] {
650 merge_state
[encoding convertfrom
$p] ?O
652 rescan_done
$fd buf_rlo
$after
655 proc rescan_done
{fd buf after
} {
657 global file_states repo_config
660 if {![eof
$fd]} return
663 if {[incr rescan_active
-1] > 0} return
672 proc prune_selection
{} {
673 global file_states selected_paths
675 foreach path
[array names selected_paths
] {
676 if {[catch
{set still_here
$file_states($path)}]} {
677 unset selected_paths
($path)
682 ######################################################################
687 global ui_diff current_diff_path current_diff_header
688 global ui_index ui_workdir
690 $ui_diff conf
-state normal
691 $ui_diff delete
0.0 end
692 $ui_diff conf
-state disabled
694 set current_diff_path
{}
695 set current_diff_header
{}
697 $ui_index tag remove in_diff
0.0 end
698 $ui_workdir tag remove in_diff
0.0 end
701 proc reshow_diff
{} {
702 global ui_status_value file_states file_lists
703 global current_diff_path current_diff_side
705 set p
$current_diff_path
707 # No diff is being shown.
708 } elseif
{$current_diff_side eq
{}
709 ||
[catch
{set s
$file_states($p)}]
710 ||
[lsearch
-sorted -exact $file_lists($current_diff_side) $p] == -1} {
713 show_diff
$p $current_diff_side
717 proc handle_empty_diff
{} {
718 global current_diff_path file_states file_lists
720 set path
$current_diff_path
721 set s
$file_states($path)
722 if {[lindex
$s 0] ne
{_M
}} return
724 info_popup
"No differences detected.
726 [short_path $path] has no changes.
728 The modification date of this file was updated
729 by another application, but the content within
730 the file was not changed.
732 A rescan will be automatically started to find
733 other files which may have the same state."
736 display_file
$path __
737 rescan
{set ui_status_value
{Ready.
}} 0
740 proc show_diff
{path w
{lno
{}}} {
741 global file_states file_lists
742 global is_3way_diff diff_active repo_config
743 global ui_diff ui_status_value ui_index ui_workdir
744 global current_diff_path current_diff_side current_diff_header
746 if {$diff_active ||
![lock_index
read]} return
750 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
756 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
759 set s
$file_states($path)
763 set current_diff_path
$path
764 set current_diff_side
$w
765 set current_diff_header
{}
766 set ui_status_value
"Loading diff of [escape_path $path]..."
768 # - Git won't give us the diff, there's nothing to compare to!
771 set max_sz
[expr {128 * 1024}]
773 set fd
[open
$path r
]
774 set content
[read $fd $max_sz]
776 set sz
[file size
$path]
780 set ui_status_value
"Unable to display [escape_path $path]"
781 error_popup
"Error loading file:\n\n$err"
784 $ui_diff conf
-state normal
785 if {![catch
{set type [exec file $path]}]} {
786 set n
[string length
$path]
787 if {[string equal
-length $n $path $type]} {
788 set type [string range
$type $n end
]
789 regsub
{^
:?\s
*} $type {} type
791 $ui_diff insert end
"* $type\n" d_@
793 if {[string first
"\0" $content] != -1} {
794 $ui_diff insert end \
795 "* Binary file (not showing content)." \
799 $ui_diff insert end \
800 "* Untracked file is $sz bytes.
801 * Showing only first $max_sz bytes.
804 $ui_diff insert end
$content
806 $ui_diff insert end
"
807 * Untracked file clipped here by [appname].
808 * To see the entire file, use an external editor.
812 $ui_diff conf
-state disabled
815 set ui_status_value
{Ready.
}
820 if {$w eq
$ui_index} {
821 lappend cmd diff-index
823 } elseif
{$w eq
$ui_workdir} {
824 if {[string index
$m 0] eq
{U
}} {
827 lappend cmd diff-files
832 lappend cmd
--no-color
833 if {$repo_config(gui.diffcontext
) > 0} {
834 lappend cmd
"-U$repo_config(gui.diffcontext)"
836 if {$w eq
$ui_index} {
842 if {[catch
{set fd
[open
$cmd r
]} err
]} {
845 set ui_status_value
"Unable to display [escape_path $path]"
846 error_popup
"Error loading diff:\n\n$err"
854 fileevent
$fd readable
[list read_diff
$fd]
857 proc read_diff
{fd
} {
858 global ui_diff ui_status_value diff_active
859 global is_3way_diff current_diff_header
861 $ui_diff conf
-state normal
862 while {[gets
$fd line
] >= 0} {
863 # -- Cleanup uninteresting diff header lines.
865 if { [string match
{diff --git *} $line]
866 ||
[string match
{diff --cc *} $line]
867 ||
[string match
{diff --combined *} $line]
868 ||
[string match
{--- *} $line]
869 ||
[string match
{+++ *} $line]} {
870 append current_diff_header
$line "\n"
873 if {[string match
{index
*} $line]} continue
874 if {$line eq
{deleted
file mode
120000}} {
875 set line
"deleted symlink"
878 # -- Automatically detect if this is a 3 way diff.
880 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
882 if {[string match
{mode
*} $line]
883 ||
[string match
{new
file *} $line]
884 ||
[string match
{deleted
file *} $line]
885 ||
[string match
{Binary files
* and
* differ
} $line]
886 ||
$line eq
{\ No newline
at end of
file}
887 ||
[regexp
{^\
* Unmerged path
} $line]} {
889 } elseif
{$is_3way_diff} {
890 set op
[string range
$line 0 1]
900 if {[regexp
{^\
+\
+([<>]{7} |
={7})} $line _g op
]} {
901 set line
[string replace
$line 0 1 { }]
908 puts
"error: Unhandled 3 way diff marker: {$op}"
913 set op
[string index
$line 0]
919 if {[regexp
{^\
+([<>]{7} |
={7})} $line _g op
]} {
920 set line
[string replace
$line 0 0 { }]
927 puts
"error: Unhandled 2 way diff marker: {$op}"
932 $ui_diff insert end
$line $tags
933 if {[string index
$line end
] eq
"\r"} {
934 $ui_diff tag add d_cr
{end
- 2c
}
936 $ui_diff insert end
"\n" $tags
938 $ui_diff conf
-state disabled
944 set ui_status_value
{Ready.
}
946 if {[$ui_diff index end
] eq
{2.0}} {
952 proc apply_hunk
{x y
} {
953 global current_diff_path current_diff_header current_diff_side
954 global ui_diff ui_index file_states
956 if {$current_diff_path eq
{} ||
$current_diff_header eq
{}} return
957 if {![lock_index apply_hunk
]} return
959 set apply_cmd
{git apply
--cached --whitespace=nowarn
}
960 set mi
[lindex
$file_states($current_diff_path) 0]
961 if {$current_diff_side eq
$ui_index} {
963 lappend apply_cmd
--reverse
964 if {[string index
$mi 0] ne
{M
}} {
970 if {[string index
$mi 1] ne
{M
}} {
976 set s_lno
[lindex
[split [$ui_diff index @
$x,$y] .
] 0]
977 set s_lno
[$ui_diff search
-backwards -regexp ^@@
$s_lno.0 0.0]
983 set e_lno
[$ui_diff search
-forwards -regexp ^@@
"$s_lno + 1 lines" end
]
989 set p
[open
"| $apply_cmd" w
]
990 fconfigure
$p -translation binary
-encoding binary
991 puts
-nonewline $p $current_diff_header
992 puts
-nonewline $p [$ui_diff get
$s_lno $e_lno]
994 error_popup
"Failed to $mode selected hunk.\n\n$err"
999 $ui_diff conf
-state normal
1000 $ui_diff delete
$s_lno $e_lno
1001 $ui_diff conf
-state disabled
1003 if {[$ui_diff get
1.0 end
] eq
"\n"} {
1009 if {$current_diff_side eq
$ui_index} {
1011 } elseif
{[string index
$mi 0] eq
{_
}} {
1017 display_file
$current_diff_path $mi
1023 ######################################################################
1027 proc load_last_commit
{} {
1028 global HEAD PARENT MERGE_HEAD commit_type ui_comm
1031 if {[llength
$PARENT] == 0} {
1032 error_popup
{There is nothing to amend.
1034 You are about to create the initial commit.
1035 There is no commit before this to amend.
1040 repository_state curType curHEAD curMERGE_HEAD
1041 if {$curType eq
{merge
}} {
1042 error_popup
{Cannot amend
while merging.
1044 You are currently
in the middle of a merge that
1045 has not been fully completed. You cannot amend
1046 the prior commit unless you first abort the
1047 current merge activity.
1055 set fd
[open
"| git cat-file commit $curHEAD" r
]
1056 fconfigure
$fd -encoding binary
-translation lf
1057 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1060 while {[gets
$fd line
] > 0} {
1061 if {[string match
{parent
*} $line]} {
1062 lappend parents
[string range
$line 7 end
]
1063 } elseif
{[string match
{encoding
*} $line]} {
1064 set enc
[string tolower
[string range
$line 9 end
]]
1067 fconfigure
$fd -encoding $enc
1068 set msg
[string trim
[read $fd]]
1071 error_popup
"Error loading commit data for amend:\n\n$err"
1077 set MERGE_HEAD
[list
]
1078 switch
-- [llength
$parents] {
1079 0 {set commit_type amend-initial
}
1080 1 {set commit_type amend
}
1081 default
{set commit_type amend-merge
}
1084 $ui_comm delete
0.0 end
1085 $ui_comm insert end
$msg
1087 $ui_comm edit modified false
1088 rescan
{set ui_status_value
{Ready.
}}
1091 proc create_new_commit
{} {
1092 global commit_type ui_comm
1094 set commit_type normal
1095 $ui_comm delete
0.0 end
1097 $ui_comm edit modified false
1098 rescan
{set ui_status_value
{Ready.
}}
1101 set GIT_COMMITTER_IDENT
{}
1103 proc committer_ident
{} {
1104 global GIT_COMMITTER_IDENT
1106 if {$GIT_COMMITTER_IDENT eq
{}} {
1107 if {[catch
{set me
[git var GIT_COMMITTER_IDENT
]} err
]} {
1108 error_popup
"Unable to obtain your identity:\n\n$err"
1111 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
1112 $me me GIT_COMMITTER_IDENT
]} {
1113 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
1118 return $GIT_COMMITTER_IDENT
1121 proc commit_tree
{} {
1122 global HEAD commit_type file_states ui_comm repo_config
1123 global ui_status_value pch_error
1125 if {[committer_ident
] eq
{}} return
1126 if {![lock_index update
]} return
1128 # -- Our in memory state should match the repository.
1130 repository_state curType curHEAD curMERGE_HEAD
1131 if {[string match amend
* $commit_type]
1132 && $curType eq
{normal
}
1133 && $curHEAD eq
$HEAD} {
1134 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1135 info_popup
{Last scanned state does not match repository state.
1137 Another Git program has modified this repository
1138 since the last scan. A rescan must be performed
1139 before another commit can be created.
1141 The rescan will be automatically started now.
1144 rescan
{set ui_status_value
{Ready.
}}
1148 # -- At least one file should differ in the index.
1151 foreach path
[array names file_states
] {
1152 switch
-glob -- [lindex
$file_states($path) 0] {
1156 M?
{set files_ready
1}
1158 error_popup
"Unmerged files cannot be committed.
1160 File [short_path $path] has merge conflicts.
1161 You must resolve them and add the file before committing.
1167 error_popup
"Unknown file state [lindex $s 0] detected.
1169 File [short_path $path] cannot be committed by this program.
1174 if {!$files_ready} {
1175 info_popup
{No changes to commit.
1177 You must add
at least
1 file before you can commit.
1183 # -- A message is required.
1185 set msg
[string trim
[$ui_comm get
1.0 end
]]
1186 regsub
-all -line {[ \t\r]+$
} $msg {} msg
1188 error_popup
{Please supply a commit message.
1190 A good commit message has the following format
:
1192 - First line
: Describe
in one sentance what you did.
1193 - Second line
: Blank
1194 - Remaining lines
: Describe why this change is good.
1200 # -- Run the pre-commit hook.
1202 set pchook
[gitdir hooks pre-commit
]
1204 # On Cygwin [file executable] might lie so we need to ask
1205 # the shell if the hook is executable. Yes that's annoying.
1207 if {[is_Cygwin
] && [file isfile
$pchook]} {
1208 set pchook
[list sh
-c [concat \
1209 "if test -x \"$pchook\";" \
1210 "then exec \"$pchook\" 2>&1;" \
1212 } elseif
{[file executable
$pchook]} {
1213 set pchook
[list
$pchook |
& cat]
1215 commit_writetree
$curHEAD $msg
1219 set ui_status_value
{Calling pre-commit hook...
}
1221 set fd_ph
[open
"| $pchook" r
]
1222 fconfigure
$fd_ph -blocking 0 -translation binary
1223 fileevent
$fd_ph readable \
1224 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
1227 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
1228 global pch_error ui_status_value
1230 append pch_error
[read $fd_ph]
1231 fconfigure
$fd_ph -blocking 1
1233 if {[catch
{close
$fd_ph}]} {
1234 set ui_status_value
{Commit declined by pre-commit hook.
}
1235 hook_failed_popup pre-commit
$pch_error
1238 commit_writetree
$curHEAD $msg
1243 fconfigure
$fd_ph -blocking 0
1246 proc commit_writetree
{curHEAD msg
} {
1247 global ui_status_value
1249 set ui_status_value
{Committing changes...
}
1250 set fd_wt
[open
"| git write-tree" r
]
1251 fileevent
$fd_wt readable \
1252 [list commit_committree
$fd_wt $curHEAD $msg]
1255 proc commit_committree
{fd_wt curHEAD msg
} {
1256 global HEAD PARENT MERGE_HEAD commit_type
1257 global all_heads current_branch
1258 global ui_status_value ui_comm selected_commit_type
1259 global file_states selected_paths rescan_active
1263 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1264 error_popup
"write-tree failed:\n\n$err"
1265 set ui_status_value
{Commit failed.
}
1270 # -- Verify this wasn't an empty change.
1272 if {$commit_type eq
{normal
}} {
1273 set old_tree
[git rev-parse
"$PARENT^{tree}"]
1274 if {$tree_id eq
$old_tree} {
1275 info_popup
{No changes to commit.
1277 No files were modified by this commit and it
1278 was not a merge commit.
1280 A rescan will be automatically started now.
1283 rescan
{set ui_status_value
{No changes to commit.
}}
1288 # -- Build the message.
1290 set msg_p
[gitdir COMMIT_EDITMSG
]
1291 set msg_wt
[open
$msg_p w
]
1292 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
1295 fconfigure
$msg_wt -encoding $enc -translation binary
1296 puts
-nonewline $msg_wt $msg
1299 # -- Create the commit.
1301 set cmd
[list git commit-tree
$tree_id]
1302 set parents
[concat
$PARENT $MERGE_HEAD]
1303 if {[llength
$parents] > 0} {
1304 foreach p
$parents {
1308 # git commit-tree writes to stderr during initial commit.
1309 lappend cmd
2>/dev
/null
1312 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1313 error_popup
"commit-tree failed:\n\n$err"
1314 set ui_status_value
{Commit failed.
}
1319 # -- Update the HEAD ref.
1322 if {$commit_type ne
{normal
}} {
1323 append reflogm
" ($commit_type)"
1325 set i
[string first
"\n" $msg]
1327 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1329 append reflogm
{: } $msg
1331 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1332 if {[catch
{eval exec $cmd} err
]} {
1333 error_popup
"update-ref failed:\n\n$err"
1334 set ui_status_value
{Commit failed.
}
1339 # -- Cleanup after ourselves.
1341 catch
{file delete
$msg_p}
1342 catch
{file delete
[gitdir MERGE_HEAD
]}
1343 catch
{file delete
[gitdir MERGE_MSG
]}
1344 catch
{file delete
[gitdir SQUASH_MSG
]}
1345 catch
{file delete
[gitdir GITGUI_MSG
]}
1347 # -- Let rerere do its thing.
1349 if {[file isdirectory
[gitdir rr-cache
]]} {
1353 # -- Run the post-commit hook.
1355 set pchook
[gitdir hooks post-commit
]
1356 if {[is_Cygwin
] && [file isfile
$pchook]} {
1357 set pchook
[list sh
-c [concat \
1358 "if test -x \"$pchook\";" \
1359 "then exec \"$pchook\";" \
1361 } elseif
{![file executable
$pchook]} {
1364 if {$pchook ne
{}} {
1365 catch
{exec $pchook &}
1368 $ui_comm delete
0.0 end
1370 $ui_comm edit modified false
1372 if {[is_enabled singlecommit
]} do_quit
1374 # -- Make sure our current branch exists.
1376 if {$commit_type eq
{initial
}} {
1377 lappend all_heads
$current_branch
1378 set all_heads
[lsort
-unique $all_heads]
1379 populate_branch_menu
1382 # -- Update in memory status
1384 set selected_commit_type new
1385 set commit_type normal
1388 set MERGE_HEAD
[list
]
1390 foreach path
[array names file_states
] {
1391 set s
$file_states($path)
1393 switch
-glob -- $m {
1401 unset file_states
($path)
1402 catch
{unset selected_paths
($path)}
1405 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1411 set file_states
($path) [list \
1412 _
[string index
$m 1] \
1423 set ui_status_value \
1424 "Changes committed as [string range $cmt_id 0 7]."
1427 ######################################################################
1431 proc fetch_from
{remote
} {
1432 set w
[new_console \
1434 "Fetching new changes from $remote"]
1435 set cmd
[list git fetch
]
1437 console_exec
$w $cmd console_done
1440 proc push_to
{remote
} {
1441 set w
[new_console \
1443 "Pushing changes to $remote"]
1444 set cmd
[list git push
]
1447 console_exec
$w $cmd console_done
1450 ######################################################################
1454 proc mapicon
{w state path
} {
1457 if {[catch
{set r
$all_icons($state$w)}]} {
1458 puts
"error: no icon for $w state={$state} $path"
1464 proc mapdesc
{state path
} {
1467 if {[catch
{set r
$all_descs($state)}]} {
1468 puts
"error: no desc for state={$state} $path"
1474 proc escape_path
{path
} {
1475 regsub
-all {\\} $path "\\\\" path
1476 regsub
-all "\n" $path "\\n" path
1480 proc short_path
{path
} {
1481 return [escape_path
[lindex
[file split $path] end
]]
1485 set null_sha1
[string repeat
0 40]
1487 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1488 global file_states next_icon_id null_sha1
1490 set s0
[string index
$new_state 0]
1491 set s1
[string index
$new_state 1]
1493 if {[catch
{set info
$file_states($path)}]} {
1495 set icon n
[incr next_icon_id
]
1497 set state
[lindex
$info 0]
1498 set icon
[lindex
$info 1]
1499 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1500 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1503 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1504 elseif
{$s0 eq
{_
}} {set s0 _
}
1506 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1507 elseif
{$s1 eq
{_
}} {set s1 _
}
1509 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1510 set head_info
[list
0 $null_sha1]
1511 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1512 && $head_info eq
{}} {
1513 set head_info
$index_info
1516 set file_states
($path) [list
$s0$s1 $icon \
1517 $head_info $index_info \
1522 proc display_file_helper
{w path icon_name old_m new_m
} {
1525 if {$new_m eq
{_
}} {
1526 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1528 set file_lists
($w) [lreplace
$file_lists($w) $lno $lno]
1530 $w conf
-state normal
1531 $w delete
$lno.0 [expr {$lno + 1}].0
1532 $w conf
-state disabled
1534 } elseif
{$old_m eq
{_
} && $new_m ne
{_
}} {
1535 lappend file_lists
($w) $path
1536 set file_lists
($w) [lsort
-unique $file_lists($w)]
1537 set lno
[lsearch
-sorted -exact $file_lists($w) $path]
1539 $w conf
-state normal
1540 $w image create
$lno.0 \
1541 -align center
-padx 5 -pady 1 \
1543 -image [mapicon
$w $new_m $path]
1544 $w insert
$lno.1 "[escape_path $path]\n"
1545 $w conf
-state disabled
1546 } elseif
{$old_m ne
$new_m} {
1547 $w conf
-state normal
1548 $w image conf
$icon_name -image [mapicon
$w $new_m $path]
1549 $w conf
-state disabled
1553 proc display_file
{path state
} {
1554 global file_states selected_paths
1555 global ui_index ui_workdir
1557 set old_m
[merge_state
$path $state]
1558 set s
$file_states($path)
1559 set new_m
[lindex
$s 0]
1560 set icon_name
[lindex
$s 1]
1562 set o
[string index
$old_m 0]
1563 set n
[string index
$new_m 0]
1570 display_file_helper
$ui_index $path $icon_name $o $n
1572 if {[string index
$old_m 0] eq
{U
}} {
1575 set o
[string index
$old_m 1]
1577 if {[string index
$new_m 0] eq
{U
}} {
1580 set n
[string index
$new_m 1]
1582 display_file_helper
$ui_workdir $path $icon_name $o $n
1584 if {$new_m eq
{__
}} {
1585 unset file_states
($path)
1586 catch
{unset selected_paths
($path)}
1590 proc display_all_files_helper
{w path icon_name m
} {
1593 lappend file_lists
($w) $path
1594 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1595 $w image create end \
1596 -align center
-padx 5 -pady 1 \
1598 -image [mapicon
$w $m $path]
1599 $w insert end
"[escape_path $path]\n"
1602 proc display_all_files
{} {
1603 global ui_index ui_workdir
1604 global file_states file_lists
1607 $ui_index conf
-state normal
1608 $ui_workdir conf
-state normal
1610 $ui_index delete
0.0 end
1611 $ui_workdir delete
0.0 end
1614 set file_lists
($ui_index) [list
]
1615 set file_lists
($ui_workdir) [list
]
1617 foreach path
[lsort
[array names file_states
]] {
1618 set s
$file_states($path)
1620 set icon_name
[lindex
$s 1]
1622 set s
[string index
$m 0]
1623 if {$s ne
{U
} && $s ne
{_
}} {
1624 display_all_files_helper
$ui_index $path \
1628 if {[string index
$m 0] eq
{U
}} {
1631 set s
[string index
$m 1]
1634 display_all_files_helper
$ui_workdir $path \
1639 $ui_index conf
-state disabled
1640 $ui_workdir conf
-state disabled
1643 proc update_indexinfo
{msg pathList after
} {
1644 global update_index_cp ui_status_value
1646 if {![lock_index update
]} return
1648 set update_index_cp
0
1649 set pathList
[lsort
$pathList]
1650 set totalCnt
[llength
$pathList]
1651 set batch [expr {int
($totalCnt * .01) + 1}]
1652 if {$batch > 25} {set batch 25}
1654 set ui_status_value
[format \
1655 "$msg... %i/%i files (%.2f%%)" \
1659 set fd
[open
"| git update-index -z --index-info" w
]
1666 fileevent
$fd writable
[list \
1667 write_update_indexinfo \
1677 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1678 global update_index_cp ui_status_value
1679 global file_states current_diff_path
1681 if {$update_index_cp >= $totalCnt} {
1688 for {set i
$batch} \
1689 {$update_index_cp < $totalCnt && $i > 0} \
1691 set path
[lindex
$pathList $update_index_cp]
1692 incr update_index_cp
1694 set s
$file_states($path)
1695 switch
-glob -- [lindex
$s 0] {
1702 set info
[lindex
$s 2]
1703 if {$info eq
{}} continue
1705 puts
-nonewline $fd "$info\t[encoding convertto $path]\0"
1706 display_file
$path $new
1709 set ui_status_value
[format \
1710 "$msg... %i/%i files (%.2f%%)" \
1713 [expr {100.0 * $update_index_cp / $totalCnt}]]
1716 proc update_index
{msg pathList after
} {
1717 global update_index_cp ui_status_value
1719 if {![lock_index update
]} return
1721 set update_index_cp
0
1722 set pathList
[lsort
$pathList]
1723 set totalCnt
[llength
$pathList]
1724 set batch [expr {int
($totalCnt * .01) + 1}]
1725 if {$batch > 25} {set batch 25}
1727 set ui_status_value
[format \
1728 "$msg... %i/%i files (%.2f%%)" \
1732 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1739 fileevent
$fd writable
[list \
1740 write_update_index \
1750 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1751 global update_index_cp ui_status_value
1752 global file_states current_diff_path
1754 if {$update_index_cp >= $totalCnt} {
1761 for {set i
$batch} \
1762 {$update_index_cp < $totalCnt && $i > 0} \
1764 set path
[lindex
$pathList $update_index_cp]
1765 incr update_index_cp
1767 switch
-glob -- [lindex
$file_states($path) 0] {
1773 if {[file exists
$path]} {
1782 puts
-nonewline $fd "[encoding convertto $path]\0"
1783 display_file
$path $new
1786 set ui_status_value
[format \
1787 "$msg... %i/%i files (%.2f%%)" \
1790 [expr {100.0 * $update_index_cp / $totalCnt}]]
1793 proc checkout_index
{msg pathList after
} {
1794 global update_index_cp ui_status_value
1796 if {![lock_index update
]} return
1798 set update_index_cp
0
1799 set pathList
[lsort
$pathList]
1800 set totalCnt
[llength
$pathList]
1801 set batch [expr {int
($totalCnt * .01) + 1}]
1802 if {$batch > 25} {set batch 25}
1804 set ui_status_value
[format \
1805 "$msg... %i/%i files (%.2f%%)" \
1809 set cmd
[list git checkout-index
]
1815 set fd
[open
"| $cmd " w
]
1822 fileevent
$fd writable
[list \
1823 write_checkout_index \
1833 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1834 global update_index_cp ui_status_value
1835 global file_states current_diff_path
1837 if {$update_index_cp >= $totalCnt} {
1844 for {set i
$batch} \
1845 {$update_index_cp < $totalCnt && $i > 0} \
1847 set path
[lindex
$pathList $update_index_cp]
1848 incr update_index_cp
1849 switch
-glob -- [lindex
$file_states($path) 0] {
1853 puts
-nonewline $fd "[encoding convertto $path]\0"
1854 display_file
$path ?_
1859 set ui_status_value
[format \
1860 "$msg... %i/%i files (%.2f%%)" \
1863 [expr {100.0 * $update_index_cp / $totalCnt}]]
1866 ######################################################################
1868 ## branch management
1870 proc is_tracking_branch
{name
} {
1871 global tracking_branches
1873 if {![catch
{set info
$tracking_branches($name)}]} {
1876 foreach t
[array names tracking_branches
] {
1877 if {[string match
{*/\
*} $t] && [string match
$t $name]} {
1884 proc load_all_heads
{} {
1887 set all_heads
[list
]
1888 set fd
[open
"| git for-each-ref --format=%(refname) refs/heads" r
]
1889 while {[gets
$fd line
] > 0} {
1890 if {[is_tracking_branch
$line]} continue
1891 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1892 lappend all_heads
$name
1896 set all_heads
[lsort
$all_heads]
1899 proc populate_branch_menu
{} {
1900 global all_heads disable_on_lock
1903 set last
[$m index last
]
1904 for {set i
0} {$i <= $last} {incr i
} {
1905 if {[$m type $i] eq
{separator
}} {
1908 foreach a
$disable_on_lock {
1909 if {[lindex
$a 0] ne
$m ||
[lindex
$a 2] < $i} {
1913 set disable_on_lock
$new_dol
1918 if {$all_heads ne
{}} {
1921 foreach b
$all_heads {
1922 $m add radiobutton \
1924 -command [list switch_branch
$b] \
1925 -variable current_branch \
1928 lappend disable_on_lock \
1929 [list
$m entryconf
[$m index last
] -state]
1933 proc all_tracking_branches
{} {
1934 global tracking_branches
1936 set all_trackings
{}
1938 foreach name
[array names tracking_branches
] {
1939 if {[regsub
{/\
*$
} $name {} name
]} {
1942 regsub ^refs
/(heads|remotes
)/ $name {} name
1943 lappend all_trackings
$name
1948 set fd
[open
"| git for-each-ref --format=%(refname) $cmd" r
]
1949 while {[gets
$fd name
] > 0} {
1950 regsub ^refs
/(heads|remotes
)/ $name {} name
1951 lappend all_trackings
$name
1956 return [lsort
-unique $all_trackings]
1959 proc load_all_tags
{} {
1961 set fd
[open
"| git for-each-ref --format=%(refname) refs/tags" r
]
1962 while {[gets
$fd line
] > 0} {
1963 if {![regsub ^refs
/tags
/ $line {} name
]} continue
1964 lappend all_tags
$name
1968 return [lsort
$all_tags]
1971 proc do_create_branch_action
{w
} {
1972 global all_heads null_sha1 repo_config
1973 global create_branch_checkout create_branch_revtype
1974 global create_branch_head create_branch_trackinghead
1975 global create_branch_name create_branch_revexp
1976 global create_branch_tag
1978 set newbranch
$create_branch_name
1979 if {$newbranch eq
{}
1980 ||
$newbranch eq
$repo_config(gui.newbranchtemplate
)} {
1984 -title [wm title
$w] \
1986 -message "Please supply a branch name."
1987 focus
$w.desc.name_t
1990 if {![catch
{git show-ref
--verify -- "refs/heads/$newbranch"}]} {
1994 -title [wm title
$w] \
1996 -message "Branch '$newbranch' already exists."
1997 focus
$w.desc.name_t
2000 if {[catch
{git check-ref-format
"heads/$newbranch"}]} {
2004 -title [wm title
$w] \
2006 -message "We do not like '$newbranch' as a branch name."
2007 focus
$w.desc.name_t
2012 switch
-- $create_branch_revtype {
2013 head {set rev $create_branch_head}
2014 tracking
{set rev $create_branch_trackinghead}
2015 tag
{set rev $create_branch_tag}
2016 expression
{set rev $create_branch_revexp}
2018 if {[catch
{set cmt
[git rev-parse
--verify "${rev}^0"]}]} {
2022 -title [wm title
$w] \
2024 -message "Invalid starting revision: $rev"
2027 set cmd
[list git update-ref
]
2029 lappend cmd
"branch: Created from $rev"
2030 lappend cmd
"refs/heads/$newbranch"
2032 lappend cmd
$null_sha1
2033 if {[catch
{eval exec $cmd} err
]} {
2037 -title [wm title
$w] \
2039 -message "Failed to create '$newbranch'.\n\n$err"
2043 lappend all_heads
$newbranch
2044 set all_heads
[lsort
$all_heads]
2045 populate_branch_menu
2047 if {$create_branch_checkout} {
2048 switch_branch
$newbranch
2052 proc radio_selector
{varname value args
} {
2053 upvar
#0 $varname var
2057 trace add variable create_branch_head
write \
2058 [list radio_selector create_branch_revtype
head]
2059 trace add variable create_branch_trackinghead
write \
2060 [list radio_selector create_branch_revtype tracking
]
2061 trace add variable create_branch_tag
write \
2062 [list radio_selector create_branch_revtype tag
]
2064 trace add variable delete_branch_head
write \
2065 [list radio_selector delete_branch_checktype
head]
2066 trace add variable delete_branch_trackinghead
write \
2067 [list radio_selector delete_branch_checktype tracking
]
2069 proc do_create_branch
{} {
2070 global all_heads current_branch repo_config
2071 global create_branch_checkout create_branch_revtype
2072 global create_branch_head create_branch_trackinghead
2073 global create_branch_name create_branch_revexp
2074 global create_branch_tag
2076 set w .branch_editor
2078 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2080 label
$w.header
-text {Create New Branch
} \
2082 pack
$w.header
-side top
-fill x
2085 button
$w.buttons.create
-text Create \
2088 -command [list do_create_branch_action
$w]
2089 pack
$w.buttons.create
-side right
2090 button
$w.buttons.cancel
-text {Cancel
} \
2092 -command [list destroy
$w]
2093 pack
$w.buttons.cancel
-side right
-padx 5
2094 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2096 labelframe
$w.desc \
2097 -text {Branch Description
} \
2099 label
$w.desc.name_l
-text {Name
:} -font font_ui
2100 entry
$w.desc.name_t \
2104 -textvariable create_branch_name \
2108 if {%d
== 1 && [regexp
{[~^
:?
*\
[\
0- ]} %S
]} {return 0}
2111 grid
$w.desc.name_l
$w.desc.name_t
-sticky we
-padx {0 5}
2112 grid columnconfigure
$w.desc
1 -weight 1
2113 pack
$w.desc
-anchor nw
-fill x
-pady 5 -padx 5
2115 labelframe
$w.from \
2116 -text {Starting Revision
} \
2118 radiobutton
$w.from.head_r \
2119 -text {Local Branch
:} \
2121 -variable create_branch_revtype \
2123 eval tk_optionMenu
$w.from.head_m create_branch_head
$all_heads
2124 grid
$w.from.head_r
$w.from.head_m
-sticky w
2125 set all_trackings
[all_tracking_branches
]
2126 if {$all_trackings ne
{}} {
2127 set create_branch_trackinghead
[lindex
$all_trackings 0]
2128 radiobutton
$w.from.tracking_r \
2129 -text {Tracking Branch
:} \
2131 -variable create_branch_revtype \
2133 eval tk_optionMenu
$w.from.tracking_m \
2134 create_branch_trackinghead \
2136 grid
$w.from.tracking_r
$w.from.tracking_m
-sticky w
2138 set all_tags
[load_all_tags
]
2139 if {$all_tags ne
{}} {
2140 set create_branch_tag
[lindex
$all_tags 0]
2141 radiobutton
$w.from.tag_r \
2144 -variable create_branch_revtype \
2146 eval tk_optionMenu
$w.from.tag_m \
2149 grid
$w.from.tag_r
$w.from.tag_m
-sticky w
2151 radiobutton
$w.from.exp_r \
2152 -text {Revision Expression
:} \
2154 -variable create_branch_revtype \
2156 entry
$w.from.exp_t \
2160 -textvariable create_branch_revexp \
2164 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2165 if {%d
== 1 && [string length
%S
] > 0} {
2166 set create_branch_revtype expression
2170 grid
$w.from.exp_r
$w.from.exp_t
-sticky we
-padx {0 5}
2171 grid columnconfigure
$w.from
1 -weight 1
2172 pack
$w.from
-anchor nw
-fill x
-pady 5 -padx 5
2174 labelframe
$w.postActions \
2175 -text {Post Creation Actions
} \
2177 checkbutton
$w.postActions.checkout \
2178 -text {Checkout after creation
} \
2179 -variable create_branch_checkout \
2181 pack
$w.postActions.checkout
-anchor nw
2182 pack
$w.postActions
-anchor nw
-fill x
-pady 5 -padx 5
2184 set create_branch_checkout
1
2185 set create_branch_head
$current_branch
2186 set create_branch_revtype
head
2187 set create_branch_name
$repo_config(gui.newbranchtemplate
)
2188 set create_branch_revexp
{}
2190 bind $w <Visibility
> "
2192 $w.desc.name_t icursor end
2193 focus $w.desc.name_t
2195 bind $w <Key-Escape
> "destroy $w"
2196 bind $w <Key-Return
> "do_create_branch_action $w;break"
2197 wm title
$w "[appname] ([reponame]): Create Branch"
2201 proc do_delete_branch_action
{w
} {
2203 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2206 switch
-- $delete_branch_checktype {
2207 head {set check_rev
$delete_branch_head}
2208 tracking
{set check_rev
$delete_branch_trackinghead}
2209 always
{set check_rev
{:none
}}
2211 if {$check_rev eq
{:none
}} {
2213 } elseif
{[catch
{set check_cmt
[git rev-parse
--verify "${check_rev}^0"]}]} {
2217 -title [wm title
$w] \
2219 -message "Invalid check revision: $check_rev"
2223 set to_delete
[list
]
2224 set not_merged
[list
]
2225 foreach i
[$w.list.l curselection
] {
2226 set b
[$w.list.l get
$i]
2227 if {[catch
{set o
[git rev-parse
--verify $b]}]} continue
2228 if {$check_cmt ne
{}} {
2229 if {$b eq
$check_rev} continue
2230 if {[catch
{set m
[git merge-base
$o $check_cmt]}]} continue
2232 lappend not_merged
$b
2236 lappend to_delete
[list
$b $o]
2238 if {$not_merged ne
{}} {
2239 set msg
"The following branches are not completely merged into $check_rev:
2241 - [join $not_merged "\n - "]"
2245 -title [wm title
$w] \
2249 if {$to_delete eq
{}} return
2250 if {$delete_branch_checktype eq
{always
}} {
2251 set msg
{Recovering deleted branches is difficult.
2253 Delete the selected branches?
}
2254 if {[tk_messageBox \
2257 -title [wm title
$w] \
2259 -message $msg] ne
yes} {
2265 foreach i
$to_delete {
2268 if {[catch
{git update-ref
-d "refs/heads/$b" $o} err
]} {
2269 append failed
" - $b: $err\n"
2271 set x
[lsearch
-sorted -exact $all_heads $b]
2273 set all_heads
[lreplace
$all_heads $x $x]
2278 if {$failed ne
{}} {
2282 -title [wm title
$w] \
2284 -message "Failed to delete branches:\n$failed"
2287 set all_heads
[lsort
$all_heads]
2288 populate_branch_menu
2292 proc do_delete_branch
{} {
2293 global all_heads tracking_branches current_branch
2294 global delete_branch_checktype delete_branch_head delete_branch_trackinghead
2296 set w .branch_editor
2298 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2300 label
$w.header
-text {Delete Local Branch
} \
2302 pack
$w.header
-side top
-fill x
2305 button
$w.buttons.create
-text Delete \
2307 -command [list do_delete_branch_action
$w]
2308 pack
$w.buttons.create
-side right
2309 button
$w.buttons.cancel
-text {Cancel
} \
2311 -command [list destroy
$w]
2312 pack
$w.buttons.cancel
-side right
-padx 5
2313 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2315 labelframe
$w.list \
2316 -text {Local Branches
} \
2321 -selectmode extended \
2322 -yscrollcommand [list
$w.list.sby
set] \
2324 foreach h
$all_heads {
2325 if {$h ne
$current_branch} {
2326 $w.list.l insert end
$h
2329 scrollbar
$w.list.sby
-command [list
$w.list.l yview
]
2330 pack
$w.list.sby
-side right
-fill y
2331 pack
$w.list.l
-side left
-fill both
-expand 1
2332 pack
$w.list
-fill both
-expand 1 -pady 5 -padx 5
2334 labelframe
$w.validate \
2335 -text {Delete Only If
} \
2337 radiobutton
$w.validate.head_r \
2338 -text {Merged Into Local Branch
:} \
2340 -variable delete_branch_checktype \
2342 eval tk_optionMenu
$w.validate.head_m delete_branch_head
$all_heads
2343 grid
$w.validate.head_r
$w.validate.head_m
-sticky w
2344 set all_trackings
[all_tracking_branches
]
2345 if {$all_trackings ne
{}} {
2346 set delete_branch_trackinghead
[lindex
$all_trackings 0]
2347 radiobutton
$w.validate.tracking_r \
2348 -text {Merged Into Tracking Branch
:} \
2350 -variable delete_branch_checktype \
2352 eval tk_optionMenu
$w.validate.tracking_m \
2353 delete_branch_trackinghead \
2355 grid
$w.validate.tracking_r
$w.validate.tracking_m
-sticky w
2357 radiobutton
$w.validate.always_r \
2358 -text {Always
(Do not perform merge checks
)} \
2360 -variable delete_branch_checktype \
2362 grid
$w.validate.always_r
-columnspan 2 -sticky w
2363 grid columnconfigure
$w.validate
1 -weight 1
2364 pack
$w.validate
-anchor nw
-fill x
-pady 5 -padx 5
2366 set delete_branch_head
$current_branch
2367 set delete_branch_checktype
head
2369 bind $w <Visibility
> "grab $w; focus $w"
2370 bind $w <Key-Escape
> "destroy $w"
2371 wm title
$w "[appname] ([reponame]): Delete Branch"
2375 proc switch_branch
{new_branch
} {
2376 global HEAD commit_type current_branch repo_config
2378 if {![lock_index switch
]} return
2380 # -- Our in memory state should match the repository.
2382 repository_state curType curHEAD curMERGE_HEAD
2383 if {[string match amend
* $commit_type]
2384 && $curType eq
{normal
}
2385 && $curHEAD eq
$HEAD} {
2386 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2387 info_popup
{Last scanned state does not match repository state.
2389 Another Git program has modified this repository
2390 since the last scan. A rescan must be performed
2391 before the current branch can be changed.
2393 The rescan will be automatically started now.
2396 rescan
{set ui_status_value
{Ready.
}}
2400 # -- Don't do a pointless switch.
2402 if {$current_branch eq
$new_branch} {
2407 if {$repo_config(gui.trustmtime
) eq
{true
}} {
2408 switch_branch_stage2
{} $new_branch
2410 set ui_status_value
{Refreshing
file status...
}
2411 set cmd
[list git update-index
]
2413 lappend cmd
--unmerged
2414 lappend cmd
--ignore-missing
2415 lappend cmd
--refresh
2416 set fd_rf
[open
"| $cmd" r
]
2417 fconfigure
$fd_rf -blocking 0 -translation binary
2418 fileevent
$fd_rf readable \
2419 [list switch_branch_stage2
$fd_rf $new_branch]
2423 proc switch_branch_stage2
{fd_rf new_branch
} {
2424 global ui_status_value HEAD
2428 if {![eof
$fd_rf]} return
2432 set ui_status_value
"Updating working directory to '$new_branch'..."
2433 set cmd
[list git read-tree
]
2436 lappend cmd
--exclude-per-directory=.gitignore
2438 lappend cmd
$new_branch
2439 set fd_rt
[open
"| $cmd" r
]
2440 fconfigure
$fd_rt -blocking 0 -translation binary
2441 fileevent
$fd_rt readable \
2442 [list switch_branch_readtree_wait
$fd_rt $new_branch]
2445 proc switch_branch_readtree_wait
{fd_rt new_branch
} {
2446 global selected_commit_type commit_type HEAD MERGE_HEAD PARENT
2447 global current_branch
2448 global ui_comm ui_status_value
2450 # -- We never get interesting output on stdout; only stderr.
2453 fconfigure
$fd_rt -blocking 1
2454 if {![eof
$fd_rt]} {
2455 fconfigure
$fd_rt -blocking 0
2459 # -- The working directory wasn't in sync with the index and
2460 # we'd have to overwrite something to make the switch. A
2461 # merge is required.
2463 if {[catch
{close
$fd_rt} err
]} {
2464 regsub
{^fatal
: } $err {} err
2465 warn_popup
"File level merge required.
2469 Staying on branch '$current_branch'."
2470 set ui_status_value
"Aborted checkout of '$new_branch' (file level merging is required)."
2475 # -- Update the symbolic ref. Core git doesn't even check for failure
2476 # here, it Just Works(tm). If it doesn't we are in some really ugly
2477 # state that is difficult to recover from within git-gui.
2479 if {[catch
{git symbolic-ref HEAD
"refs/heads/$new_branch"} err
]} {
2480 error_popup
"Failed to set current branch.
2482 This working directory is only partially switched.
2483 We successfully updated your files, but failed to
2484 update an internal Git file.
2486 This should not have occurred. [appname] will now
2494 # -- Update our repository state. If we were previously in amend mode
2495 # we need to toss the current buffer and do a full rescan to update
2496 # our file lists. If we weren't in amend mode our file lists are
2497 # accurate and we can avoid the rescan.
2500 set selected_commit_type new
2501 if {[string match amend
* $commit_type]} {
2502 $ui_comm delete
0.0 end
2504 $ui_comm edit modified false
2505 rescan
{set ui_status_value
"Checked out branch '$current_branch'."}
2507 repository_state commit_type HEAD MERGE_HEAD
2509 set ui_status_value
"Checked out branch '$current_branch'."
2513 ######################################################################
2515 ## remote management
2517 proc load_all_remotes
{} {
2519 global all_remotes tracking_branches
2521 set all_remotes
[list
]
2522 array
unset tracking_branches
2524 set rm_dir
[gitdir remotes
]
2525 if {[file isdirectory
$rm_dir]} {
2526 set all_remotes
[glob \
2530 -directory $rm_dir *]
2532 foreach name
$all_remotes {
2534 set fd
[open
[file join $rm_dir $name] r
]
2535 while {[gets
$fd line
] >= 0} {
2536 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
2537 $line line src dst
]} continue
2538 if {![regexp ^refs
/ $dst]} {
2539 set dst
"refs/heads/$dst"
2541 set tracking_branches
($dst) [list
$name $src]
2548 foreach line
[array names repo_config remote.
*.url
] {
2549 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
2550 lappend all_remotes
$name
2552 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
2556 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
2557 if {![regexp ^refs
/ $dst]} {
2558 set dst
"refs/heads/$dst"
2560 set tracking_branches
($dst) [list
$name $src]
2564 set all_remotes
[lsort
-unique $all_remotes]
2567 proc populate_fetch_menu
{} {
2568 global all_remotes repo_config
2571 foreach r
$all_remotes {
2573 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2574 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
2579 set fd
[open
[gitdir remotes
$r] r
]
2580 while {[gets
$fd n
] >= 0} {
2581 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
2592 -label "Fetch from $r..." \
2593 -command [list fetch_from
$r] \
2599 proc populate_push_menu
{} {
2600 global all_remotes repo_config
2604 foreach r
$all_remotes {
2606 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
2607 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
2612 set fd
[open
[gitdir remotes
$r] r
]
2613 while {[gets
$fd n
] >= 0} {
2614 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
2628 -label "Push to $r..." \
2629 -command [list push_to
$r] \
2636 proc start_push_anywhere_action
{w
} {
2637 global push_urltype push_remote push_url push_thin push_tags
2640 switch
-- $push_urltype {
2641 remote
{set r_url
$push_remote}
2642 url
{set r_url
$push_url}
2644 if {$r_url eq
{}} return
2646 set cmd
[list git push
]
2656 foreach i
[$w.
source.l curselection
] {
2657 set b
[$w.
source.l get
$i]
2658 lappend cmd
"refs/heads/$b:refs/heads/$b"
2663 } elseif
{$cnt == 1} {
2669 set cons
[new_console
"push $r_url" "Pushing $cnt $unit to $r_url"]
2670 console_exec
$cons $cmd console_done
2674 trace add variable push_remote
write \
2675 [list radio_selector push_urltype remote
]
2677 proc do_push_anywhere
{} {
2678 global all_heads all_remotes current_branch
2679 global push_urltype push_remote push_url push_thin push_tags
2683 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2685 label
$w.header
-text {Push Branches
} -font font_uibold
2686 pack
$w.header
-side top
-fill x
2689 button
$w.buttons.create
-text Push \
2691 -command [list start_push_anywhere_action
$w]
2692 pack
$w.buttons.create
-side right
2693 button
$w.buttons.cancel
-text {Cancel
} \
2695 -command [list destroy
$w]
2696 pack
$w.buttons.cancel
-side right
-padx 5
2697 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2699 labelframe
$w.
source \
2700 -text {Source Branches
} \
2702 listbox
$w.
source.l \
2705 -selectmode extended \
2706 -yscrollcommand [list
$w.
source.sby
set] \
2708 foreach h
$all_heads {
2709 $w.
source.l insert end
$h
2710 if {$h eq
$current_branch} {
2711 $w.
source.l
select set end
2714 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2715 pack
$w.
source.sby
-side right
-fill y
2716 pack
$w.
source.l
-side left
-fill both
-expand 1
2717 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2719 labelframe
$w.dest \
2720 -text {Destination Repository
} \
2722 if {$all_remotes ne
{}} {
2723 radiobutton
$w.dest.remote_r \
2726 -variable push_urltype \
2728 eval tk_optionMenu
$w.dest.remote_m push_remote
$all_remotes
2729 grid
$w.dest.remote_r
$w.dest.remote_m
-sticky w
2730 if {[lsearch
-sorted -exact $all_remotes origin
] != -1} {
2731 set push_remote origin
2733 set push_remote
[lindex
$all_remotes 0]
2735 set push_urltype remote
2737 set push_urltype url
2739 radiobutton
$w.dest.url_r \
2740 -text {Arbitrary URL
:} \
2742 -variable push_urltype \
2744 entry
$w.dest.url_t \
2748 -textvariable push_url \
2752 if {%d
== 1 && [regexp
{\s
} %S
]} {return 0}
2753 if {%d
== 1 && [string length
%S
] > 0} {
2754 set push_urltype url
2758 grid
$w.dest.url_r
$w.dest.url_t
-sticky we
-padx {0 5}
2759 grid columnconfigure
$w.dest
1 -weight 1
2760 pack
$w.dest
-anchor nw
-fill x
-pady 5 -padx 5
2762 labelframe
$w.options \
2763 -text {Transfer Options
} \
2765 checkbutton
$w.options.thin \
2766 -text {Use thin pack
(for slow network connections
)} \
2767 -variable push_thin \
2769 grid
$w.options.thin
-columnspan 2 -sticky w
2770 checkbutton
$w.options.tags \
2771 -text {Include tags
} \
2772 -variable push_tags \
2774 grid
$w.options.tags
-columnspan 2 -sticky w
2775 grid columnconfigure
$w.options
1 -weight 1
2776 pack
$w.options
-anchor nw
-fill x
-pady 5 -padx 5
2782 bind $w <Visibility
> "grab $w"
2783 bind $w <Key-Escape
> "destroy $w"
2784 wm title
$w "[appname] ([reponame]): Push"
2788 ######################################################################
2793 global HEAD commit_type file_states
2795 if {[string match amend
* $commit_type]} {
2796 info_popup
{Cannot merge
while amending.
2798 You must finish amending this commit before
2799 starting any
type of merge.
2804 if {[committer_ident
] eq
{}} {return 0}
2805 if {![lock_index merge
]} {return 0}
2807 # -- Our in memory state should match the repository.
2809 repository_state curType curHEAD curMERGE_HEAD
2810 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
2811 info_popup
{Last scanned state does not match repository state.
2813 Another Git program has modified this repository
2814 since the last scan. A rescan must be performed
2815 before a merge can be performed.
2817 The rescan will be automatically started now.
2820 rescan
{set ui_status_value
{Ready.
}}
2824 foreach path
[array names file_states
] {
2825 switch
-glob -- [lindex
$file_states($path) 0] {
2827 continue; # and pray it works!
2830 error_popup
"You are in the middle of a conflicted merge.
2832 File [short_path $path] has merge conflicts.
2834 You must resolve them, add the file, and commit to
2835 complete the current merge. Only then can you
2836 begin another merge.
2842 error_popup
"You are in the middle of a change.
2844 File [short_path $path] is modified.
2846 You should complete the current commit before
2847 starting a merge. Doing so will help you abort
2848 a failed merge, should the need arise.
2859 proc visualize_local_merge
{w
} {
2861 foreach i
[$w.
source.l curselection
] {
2862 lappend revs
[$w.
source.l get
$i]
2864 if {$revs eq
{}} return
2865 lappend revs
--not HEAD
2869 proc start_local_merge_action
{w
} {
2870 global HEAD ui_status_value current_branch
2872 set cmd
[list git merge
]
2875 foreach i
[$w.
source.l curselection
] {
2876 set b
[$w.
source.l get
$i]
2884 } elseif
{$revcnt == 1} {
2886 } elseif
{$revcnt <= 15} {
2892 -title [wm title
$w] \
2894 -message "Too many branches selected.
2896 You have requested to merge $revcnt branches
2897 in an octopus merge. This exceeds Git's
2898 internal limit of 15 branches per merge.
2900 Please select fewer branches. To merge more
2901 than 15 branches, merge the branches in batches.
2906 set msg
"Merging $current_branch, [join $names {, }]"
2907 set ui_status_value
"$msg..."
2908 set cons
[new_console
"Merge" $msg]
2909 console_exec
$cons $cmd [list finish_merge
$revcnt]
2910 bind $w <Destroy
> {}
2914 proc finish_merge
{revcnt w ok
} {
2917 set msg
{Merge completed successfully.
}
2920 info_popup
"Octopus merge failed.
2922 Your merge of $revcnt branches has failed.
2924 There are file-level conflicts between the
2925 branches which must be resolved manually.
2927 The working directory will now be reset.
2929 You can attempt this merge again
2930 by merging only one branch at a time." $w
2932 set fd
[open
"| git read-tree --reset -u HEAD" r
]
2933 fconfigure
$fd -blocking 0 -translation binary
2934 fileevent
$fd readable
[list reset_hard_wait
$fd]
2935 set ui_status_value
{Aborting... please
wait...
}
2939 set msg
{Merge failed. Conflict resolution is required.
}
2942 rescan
[list
set ui_status_value
$msg]
2945 proc do_local_merge
{} {
2946 global current_branch
2948 if {![can_merge
]} return
2952 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2955 -text "Merge Into $current_branch" \
2957 pack
$w.header
-side top
-fill x
2960 button
$w.buttons.visualize
-text Visualize \
2962 -command [list visualize_local_merge
$w]
2963 pack
$w.buttons.visualize
-side left
2964 button
$w.buttons.create
-text Merge \
2966 -command [list start_local_merge_action
$w]
2967 pack
$w.buttons.create
-side right
2968 button
$w.buttons.cancel
-text {Cancel
} \
2970 -command [list destroy
$w]
2971 pack
$w.buttons.cancel
-side right
-padx 5
2972 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2974 labelframe
$w.
source \
2975 -text {Source Branches
} \
2977 listbox
$w.
source.l \
2980 -selectmode extended \
2981 -yscrollcommand [list
$w.
source.sby
set] \
2983 scrollbar
$w.
source.sby
-command [list
$w.
source.l yview
]
2984 pack
$w.
source.sby
-side right
-fill y
2985 pack
$w.
source.l
-side left
-fill both
-expand 1
2986 pack
$w.
source -fill both
-expand 1 -pady 5 -padx 5
2988 set cmd
[list git for-each-ref
]
2989 lappend cmd
{--format=%(objectname
) %(*objectname
) %(refname
)}
2990 lappend cmd refs
/heads
2991 lappend cmd refs
/remotes
2992 lappend cmd refs
/tags
2993 set fr_fd
[open
"| $cmd" r
]
2994 fconfigure
$fr_fd -translation binary
2995 while {[gets
$fr_fd line
] > 0} {
2996 set line
[split $line { }]
2997 set sha1
([lindex
$line 0]) [lindex
$line 2]
2998 set sha1
([lindex
$line 1]) [lindex
$line 2]
3003 set fr_fd
[open
"| git rev-list --all --not HEAD"]
3004 while {[gets
$fr_fd line
] > 0} {
3005 if {[catch
{set ref
$sha1($line)}]} continue
3006 regsub ^refs
/(heads|remotes|tags
)/ $ref {} ref
3007 lappend to_show
$ref
3011 foreach ref
[lsort
-unique $to_show] {
3012 $w.
source.l insert end
$ref
3015 bind $w <Visibility
> "grab $w"
3016 bind $w <Key-Escape
> "unlock_index;destroy $w"
3017 bind $w <Destroy
> unlock_index
3018 wm title
$w "[appname] ([reponame]): Merge"
3022 proc do_reset_hard
{} {
3023 global HEAD commit_type file_states
3025 if {[string match amend
* $commit_type]} {
3026 info_popup
{Cannot abort
while amending.
3028 You must finish amending this commit.
3033 if {![lock_index abort
]} return
3035 if {[string match
*merge
* $commit_type]} {
3041 if {[ask_popup
"Abort $op?
3043 Aborting the current $op will cause
3044 *ALL* uncommitted changes to be lost.
3046 Continue with aborting the current $op?"] eq
{yes}} {
3047 set fd
[open
"| git read-tree --reset -u HEAD" r
]
3048 fconfigure
$fd -blocking 0 -translation binary
3049 fileevent
$fd readable
[list reset_hard_wait
$fd]
3050 set ui_status_value
{Aborting... please
wait...
}
3056 proc reset_hard_wait
{fd
} {
3064 $ui_comm delete
0.0 end
3065 $ui_comm edit modified false
3067 catch
{file delete
[gitdir MERGE_HEAD
]}
3068 catch
{file delete
[gitdir rr-cache MERGE_RR
]}
3069 catch
{file delete
[gitdir SQUASH_MSG
]}
3070 catch
{file delete
[gitdir MERGE_MSG
]}
3071 catch
{file delete
[gitdir GITGUI_MSG
]}
3073 rescan
{set ui_status_value
{Abort completed. Ready.
}}
3077 ######################################################################
3081 set next_browser_id
0
3083 proc new_browser
{commit
} {
3084 global next_browser_id cursor_ptr M1B
3085 global browser_commit browser_status browser_stack browser_path browser_busy
3087 if {[winfo ismapped .
]} {
3088 set w .browser
[incr next_browser_id
]
3095 set w_list
$w.list.l
3096 set browser_commit
($w_list) $commit
3097 set browser_status
($w_list) {Starting...
}
3098 set browser_stack
($w_list) {}
3099 set browser_path
($w_list) $browser_commit($w_list):
3100 set browser_busy
($w_list) 1
3102 label
$w.path
-textvariable browser_path
($w_list) \
3108 pack
$w.path
-anchor w
-side top
-fill x
3111 text
$w_list -background white
-borderwidth 0 \
3112 -cursor $cursor_ptr \
3117 -xscrollcommand [list
$w.list.sbx
set] \
3118 -yscrollcommand [list
$w.list.sby
set] \
3120 $w_list tag conf in_sel \
3121 -background [$w_list cget
-foreground] \
3122 -foreground [$w_list cget
-background]
3123 scrollbar
$w.list.sbx
-orient h
-command [list
$w_list xview
]
3124 scrollbar
$w.list.sby
-orient v
-command [list
$w_list yview
]
3125 pack
$w.list.sbx
-side bottom
-fill x
3126 pack
$w.list.sby
-side right
-fill y
3127 pack
$w_list -side left
-fill both
-expand 1
3128 pack
$w.list
-side top
-fill both
-expand 1
3130 label
$w.status
-textvariable browser_status
($w_list) \
3136 pack
$w.status
-anchor w
-side bottom
-fill x
3138 bind $w_list <Button-1
> "browser_click 0 $w_list @%x,%y;break"
3139 bind $w_list <Double-Button-1
> "browser_click 1 $w_list @%x,%y;break"
3140 bind $w_list <$M1B-Up> "browser_parent $w_list;break"
3141 bind $w_list <$M1B-Left> "browser_parent $w_list;break"
3142 bind $w_list <Up
> "browser_move -1 $w_list;break"
3143 bind $w_list <Down
> "browser_move 1 $w_list;break"
3144 bind $w_list <$M1B-Right> "browser_enter $w_list;break"
3145 bind $w_list <Return
> "browser_enter $w_list;break"
3146 bind $w_list <Prior
> "browser_page -1 $w_list;break"
3147 bind $w_list <Next
> "browser_page 1 $w_list;break"
3148 bind $w_list <Left
> break
3149 bind $w_list <Right
> break
3151 bind $tl <Visibility
> "focus $w"
3152 bind $tl <Destroy
> "
3153 array unset browser_buffer $w_list
3154 array unset browser_files $w_list
3155 array unset browser_status $w_list
3156 array unset browser_stack $w_list
3157 array unset browser_path $w_list
3158 array unset browser_commit $w_list
3159 array unset browser_busy $w_list
3161 wm title
$tl "[appname] ([reponame]): File Browser"
3162 ls_tree
$w_list $browser_commit($w_list) {}
3165 proc browser_move
{dir w
} {
3166 global browser_files browser_busy
3168 if {$browser_busy($w)} return
3169 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3171 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3172 $w tag remove in_sel
0.0 end
3173 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3178 proc browser_page
{dir w
} {
3179 global browser_files browser_busy
3181 if {$browser_busy($w)} return
3182 $w yview scroll
$dir pages
3184 [lindex
[$w yview
] 0]
3185 * [llength
$browser_files($w)]
3187 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3188 $w tag remove in_sel
0.0 end
3189 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3194 proc browser_parent
{w
} {
3195 global browser_files browser_status browser_path
3196 global browser_stack browser_busy
3198 if {$browser_busy($w)} return
3199 set info
[lindex
$browser_files($w) 0]
3200 if {[lindex
$info 0] eq
{parent
}} {
3201 set parent
[lindex
$browser_stack($w) end-1
]
3202 set browser_stack
($w) [lrange
$browser_stack($w) 0 end-2
]
3203 if {$browser_stack($w) eq
{}} {
3204 regsub
{:.
*$
} $browser_path($w) {:} browser_path
($w)
3206 regsub
{/[^
/]+$
} $browser_path($w) {} browser_path
($w)
3208 set browser_status
($w) "Loading $browser_path($w)..."
3209 ls_tree
$w [lindex
$parent 0] [lindex
$parent 1]
3213 proc browser_enter
{w
} {
3214 global browser_files browser_status browser_path
3215 global browser_commit browser_stack browser_busy
3217 if {$browser_busy($w)} return
3218 set lno
[lindex
[split [$w index in_sel.first
] .
] 0]
3219 set info
[lindex
$browser_files($w) [expr {$lno - 1}]]
3221 switch
-- [lindex
$info 0] {
3226 set name
[lindex
$info 2]
3227 set escn
[escape_path
$name]
3228 set browser_status
($w) "Loading $escn..."
3229 append browser_path
($w) $escn
3230 ls_tree
$w [lindex
$info 1] $name
3233 set name
[lindex
$info 2]
3235 foreach n
$browser_stack($w) {
3236 append p
[lindex
$n 1]
3239 show_blame
$browser_commit($w) $p
3245 proc browser_click
{was_double_click w pos
} {
3246 global browser_files browser_busy
3248 if {$browser_busy($w)} return
3249 set lno
[lindex
[split [$w index
$pos] .
] 0]
3252 if {[lindex
$browser_files($w) [expr {$lno - 1}]] ne
{}} {
3253 $w tag remove in_sel
0.0 end
3254 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
3255 if {$was_double_click} {
3261 proc ls_tree
{w tree_id name
} {
3262 global browser_buffer browser_files browser_stack browser_busy
3264 set browser_buffer
($w) {}
3265 set browser_files
($w) {}
3266 set browser_busy
($w) 1
3268 $w conf
-state normal
3269 $w tag remove in_sel
0.0 end
3271 if {$browser_stack($w) ne
{}} {
3272 $w image create end \
3273 -align center
-padx 5 -pady 1 \
3276 $w insert end
{[Up To Parent
]}
3277 lappend browser_files
($w) parent
3279 lappend browser_stack
($w) [list
$tree_id $name]
3280 $w conf
-state disabled
3282 set cmd
[list git ls-tree
-z $tree_id]
3283 set fd
[open
"| $cmd" r
]
3284 fconfigure
$fd -blocking 0 -translation binary
-encoding binary
3285 fileevent
$fd readable
[list read_ls_tree
$fd $w]
3288 proc read_ls_tree
{fd w
} {
3289 global browser_buffer browser_files browser_status browser_busy
3291 if {![winfo exists
$w]} {
3296 append browser_buffer
($w) [read $fd]
3297 set pck
[split $browser_buffer($w) "\0"]
3298 set browser_buffer
($w) [lindex
$pck end
]
3300 set n
[llength
$browser_files($w)]
3301 $w conf
-state normal
3302 foreach p
[lrange
$pck 0 end-1
] {
3303 set info
[split $p "\t"]
3304 set path
[lindex
$info 1]
3305 set info
[split [lindex
$info 0] { }]
3306 set type [lindex
$info 1]
3307 set object
[lindex
$info 2]
3318 set image file_question
3322 if {$n > 0} {$w insert end
"\n"}
3323 $w image create end \
3324 -align center
-padx 5 -pady 1 \
3325 -name icon
[incr n
] \
3327 $w insert end
[escape_path
$path]
3328 lappend browser_files
($w) [list
$type $object $path]
3330 $w conf
-state disabled
3334 set browser_status
($w) Ready.
3335 set browser_busy
($w) 0
3336 array
unset browser_buffer
$w
3338 $w tag add in_sel
1.0 2.0
3344 proc show_blame
{commit path
} {
3345 global next_browser_id blame_status blame_data
3347 if {[winfo ismapped .
]} {
3348 set w .browser
[incr next_browser_id
]
3355 set blame_status
($w) {Loading current
file content...
}
3357 label
$w.path
-text "$commit:$path" \
3363 pack
$w.path
-side top
-fill x
3366 text
$w.out.loaded_t \
3367 -background white
-borderwidth 0 \
3373 $w.out.loaded_t tag conf annotated
-background grey
3375 text
$w.out.linenumber_t \
3376 -background white
-borderwidth 0 \
3382 $w.out.linenumber_t tag conf linenumber
-justify right
3384 text
$w.out.file_t \
3385 -background white
-borderwidth 0 \
3390 -xscrollcommand [list
$w.out.sbx
set] \
3393 scrollbar
$w.out.sbx
-orient h
-command [list
$w.out.file_t xview
]
3394 scrollbar
$w.out.sby
-orient v \
3395 -command [list scrollbar2many
[list \
3397 $w.out.linenumber_t \
3401 $w.out.linenumber_t \
3406 grid conf
$w.out.sbx
-column 2 -sticky we
3407 grid columnconfigure
$w.out
2 -weight 1
3408 grid rowconfigure
$w.out
0 -weight 1
3409 pack
$w.out
-fill both
-expand 1
3411 label
$w.status
-textvariable blame_status
($w) \
3417 pack
$w.status
-side bottom
-fill x
3421 -background white
-borderwidth 0 \
3426 -xscrollcommand [list
$w.cm.sbx
set] \
3427 -yscrollcommand [list
$w.cm.sby
set] \
3429 scrollbar
$w.cm.sbx
-orient h
-command [list
$w.cm.t xview
]
3430 scrollbar
$w.cm.sby
-orient v
-command [list
$w.cm.t yview
]
3431 pack
$w.cm.sby
-side right
-fill y
3432 pack
$w.cm.sbx
-side bottom
-fill x
3433 pack
$w.cm.t
-expand 1 -fill both
3434 pack
$w.cm
-side bottom
-fill x
3436 menu
$w.ctxm
-tearoff 0
3437 $w.ctxm add
command -label "Copy Commit" \
3439 -command "blame_copycommit $w \$cursorW @\$cursorX,\$cursorY"
3443 $w.out.linenumber_t \
3445 $i tag conf in_sel \
3446 -background [$i cget
-foreground] \
3447 -foreground [$i cget
-background]
3448 $i conf
-yscrollcommand \
3449 [list many2scrollbar
[list \
3451 $w.out.linenumber_t \
3454 bind $i <Button-1
> "
3457 $w.out.linenumber_t \\
3466 tk_popup $w.ctxm %X %Y
3470 bind $w.cm.t
<Button-1
> "focus $w.cm.t"
3471 bind $tl <Visibility
> "focus $tl"
3472 bind $tl <Destroy
> "
3473 array unset blame_status {$w}
3474 array unset blame_data $w,*
3476 wm title
$tl "[appname] ([reponame]): File Viewer"
3478 set blame_data
($w,commit_count
) 0
3479 set blame_data
($w,commit_list
) {}
3480 set blame_data
($w,total_lines
) 0
3481 set blame_data
($w,blame_lines
) 0
3482 set blame_data
($w,highlight_commit
) {}
3483 set blame_data
($w,highlight_line
) -1
3485 set cmd
[list git cat-file blob
"$commit:$path"]
3486 set fd
[open
"| $cmd" r
]
3487 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3488 fileevent
$fd readable
[list read_blame_catfile \
3489 $fd $w $commit $path \
3490 $w.cm.t
$w.out.loaded_t
$w.out.linenumber_t
$w.out.file_t
]
3493 proc read_blame_catfile
{fd w commit path w_cmit w_load w_line w_file
} {
3494 global blame_status blame_data
3496 if {![winfo exists
$w_file]} {
3501 set n
$blame_data($w,total_lines
)
3502 $w_load conf
-state normal
3503 $w_line conf
-state normal
3504 $w_file conf
-state normal
3505 while {[gets
$fd line
] >= 0} {
3506 regsub
"\r\$" $line {} line
3508 $w_load insert end
"\n"
3509 $w_line insert end
"$n\n" linenumber
3510 $w_file insert end
"$line\n"
3512 $w_load conf
-state disabled
3513 $w_line conf
-state disabled
3514 $w_file conf
-state disabled
3515 set blame_data
($w,total_lines
) $n
3519 blame_incremental_status
$w
3520 set cmd
[list git blame
-M -C --incremental]
3521 lappend cmd
$commit -- $path
3522 set fd
[open
"| $cmd" r
]
3523 fconfigure
$fd -blocking 0 -translation lf
-encoding binary
3524 fileevent
$fd readable
[list read_blame_incremental
$fd $w \
3525 $w_load $w_cmit $w_line $w_file]
3529 proc read_blame_incremental
{fd w w_load w_cmit w_line w_file
} {
3530 global blame_status blame_data
3532 if {![winfo exists
$w_file]} {
3537 while {[gets
$fd line
] >= 0} {
3538 if {[regexp
{^
([a-z0-9
]{40}) (\d
+) (\d
+) (\d
+)$
} $line line \
3539 cmit original_line final_line line_count
]} {
3540 set blame_data
($w,commit
) $cmit
3541 set blame_data
($w,original_line
) $original_line
3542 set blame_data
($w,final_line
) $final_line
3543 set blame_data
($w,line_count
) $line_count
3545 if {[catch
{set g
$blame_data($w,$cmit,order
)}]} {
3546 $w_line tag conf g
$cmit
3547 $w_file tag conf g
$cmit
3548 $w_line tag raise in_sel
3549 $w_file tag raise in_sel
3550 $w_file tag raise sel
3551 set blame_data
($w,$cmit,order
) $blame_data($w,commit_count
)
3552 incr blame_data
($w,commit_count
)
3553 lappend blame_data
($w,commit_list
) $cmit
3555 } elseif
{[string match
{filename
*} $line]} {
3556 set file [string range
$line 9 end
]
3557 set n
$blame_data($w,line_count
)
3558 set lno
$blame_data($w,final_line
)
3559 set cmit
$blame_data($w,commit
)
3562 if {[catch
{set g g
$blame_data($w,line
$lno,commit
)}]} {
3563 $w_load tag add annotated
$lno.0 "$lno.0 lineend + 1c"
3565 $w_line tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3566 $w_file tag remove g
$g $lno.0 "$lno.0 lineend + 1c"
3569 set blame_data
($w,line
$lno,commit
) $cmit
3570 set blame_data
($w,line
$lno,file) $file
3571 $w_line tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3572 $w_file tag add g
$cmit $lno.0 "$lno.0 lineend + 1c"
3574 if {$blame_data($w,highlight_line
) == -1} {
3575 if {[lindex
[$w_file yview
] 0] == 0} {
3577 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3579 } elseif
{$blame_data($w,highlight_line
) == $lno} {
3580 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3585 incr blame_data
($w,blame_lines
)
3588 set hc
$blame_data($w,highlight_commit
)
3590 && [expr {$blame_data($w,$hc,order
) + 1}]
3591 == $blame_data($w,$cmit,order
)} {
3592 blame_showcommit
$w $w_cmit $w_line $w_file \
3593 $blame_data($w,highlight_line
)
3595 } elseif
{[regexp
{^
([a-z-
]+) (.
*)$
} $line line header data
]} {
3596 set blame_data
($w,$blame_data($w,commit
),$header) $data
3602 set blame_status
($w) {Annotation complete.
}
3604 blame_incremental_status
$w
3608 proc blame_incremental_status
{w
} {
3609 global blame_status blame_data
3611 set blame_status
($w) [format \
3612 "Loading annotations... %i of %i lines annotated (%2i%%)" \
3613 $blame_data($w,blame_lines
) \
3614 $blame_data($w,total_lines
) \
3615 [expr {100 * $blame_data($w,blame_lines
)
3616 / $blame_data($w,total_lines
)}]]
3619 proc blame_click
{w w_cmit w_line w_file cur_w pos
} {
3620 set lno
[lindex
[split [$cur_w index
$pos] .
] 0]
3621 if {$lno eq
{}} return
3623 $w_line tag remove in_sel
0.0 end
3624 $w_file tag remove in_sel
0.0 end
3625 $w_line tag add in_sel
$lno.0 "$lno.0 + 1 line"
3626 $w_file tag add in_sel
$lno.0 "$lno.0 + 1 line"
3628 blame_showcommit
$w $w_cmit $w_line $w_file $lno
3637 proc blame_showcommit
{w w_cmit w_line w_file lno
} {
3638 global blame_colors blame_data repo_config
3640 set cmit
$blame_data($w,highlight_commit
)
3642 set idx
$blame_data($w,$cmit,order
)
3644 foreach c
$blame_colors {
3645 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3646 $w_line tag conf g
$h -background white
3647 $w_file tag conf g
$h -background white
3652 $w_cmit conf
-state normal
3653 $w_cmit delete
0.0 end
3654 if {[catch
{set cmit
$blame_data($w,line
$lno,commit
)}]} {
3656 $w_cmit insert end
"Loading annotation..."
3658 set idx
$blame_data($w,$cmit,order
)
3660 foreach c
$blame_colors {
3661 set h
[lindex
$blame_data($w,commit_list
) [expr {$idx - 1 + $i}]]
3662 $w_line tag conf g
$h -background $c
3663 $w_file tag conf g
$h -background $c
3667 if {[catch
{set msg
$blame_data($w,$cmit,message
)}]} {
3670 set fd
[open
"| git cat-file commit $cmit" r
]
3671 fconfigure
$fd -encoding binary
-translation lf
3672 if {[catch
{set enc
$repo_config(i18n.commitencoding
)}]} {
3675 while {[gets
$fd line
] > 0} {
3676 if {[string match
{encoding
*} $line]} {
3677 set enc
[string tolower
[string range
$line 9 end
]]
3680 fconfigure
$fd -encoding $enc
3681 set msg
[string trim
[read $fd]]
3684 set blame_data
($w,$cmit,message
) $msg
3690 catch
{set author_name
$blame_data($w,$cmit,author
)}
3691 catch
{set author_email
$blame_data($w,$cmit,author-mail
)}
3692 catch
{set author_time
[clock format
$blame_data($w,$cmit,author-time
)]}
3694 set committer_name
{}
3695 set committer_email
{}
3696 set committer_time
{}
3697 catch
{set committer_name
$blame_data($w,$cmit,committer
)}
3698 catch
{set committer_email
$blame_data($w,$cmit,committer-mail
)}
3699 catch
{set committer_time
[clock format
$blame_data($w,$cmit,committer-time
)]}
3701 $w_cmit insert end
"commit $cmit\n"
3702 $w_cmit insert end
"Author: $author_name $author_email $author_time\n"
3703 $w_cmit insert end
"Committer: $committer_name $committer_email $committer_time\n"
3704 $w_cmit insert end
"Original File: [escape_path $blame_data($w,line$lno,file)]\n"
3705 $w_cmit insert end
"\n"
3706 $w_cmit insert end
$msg
3708 $w_cmit conf
-state disabled
3710 set blame_data
($w,highlight_line
) $lno
3711 set blame_data
($w,highlight_commit
) $cmit
3714 proc blame_copycommit
{w i pos
} {
3716 set lno
[lindex
[split [$i index
$pos] .
] 0]
3717 if {![catch
{set commit
$blame_data($w,line
$lno,commit
)}]} {
3726 ######################################################################
3731 #define mask_width 14
3732 #define mask_height 15
3733 static unsigned char mask_bits
[] = {
3734 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3735 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
3736 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
3739 image create bitmap file_plain
-background white
-foreground black
-data {
3740 #define plain_width 14
3741 #define plain_height 15
3742 static unsigned char plain_bits
[] = {
3743 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3744 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
3745 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3746 } -maskdata $filemask
3748 image create bitmap file_mod
-background white
-foreground blue
-data {
3749 #define mod_width 14
3750 #define mod_height 15
3751 static unsigned char mod_bits
[] = {
3752 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3753 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3754 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3755 } -maskdata $filemask
3757 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
3758 #define file_fulltick_width 14
3759 #define file_fulltick_height 15
3760 static unsigned char file_fulltick_bits
[] = {
3761 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
3762 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
3763 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3764 } -maskdata $filemask
3766 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
3767 #define parttick_width 14
3768 #define parttick_height 15
3769 static unsigned char parttick_bits
[] = {
3770 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
3771 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
3772 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3773 } -maskdata $filemask
3775 image create bitmap file_question
-background white
-foreground black
-data {
3776 #define file_question_width 14
3777 #define file_question_height 15
3778 static unsigned char file_question_bits
[] = {
3779 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
3780 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
3781 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
3782 } -maskdata $filemask
3784 image create bitmap file_removed
-background white
-foreground red
-data {
3785 #define file_removed_width 14
3786 #define file_removed_height 15
3787 static unsigned char file_removed_bits
[] = {
3788 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
3789 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
3790 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
3791 } -maskdata $filemask
3793 image create bitmap file_merge
-background white
-foreground blue
-data {
3794 #define file_merge_width 14
3795 #define file_merge_height 15
3796 static unsigned char file_merge_bits
[] = {
3797 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
3798 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
3799 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
3800 } -maskdata $filemask
3803 #define file_width 18
3804 #define file_height 18
3805 static unsigned char file_bits
[] = {
3806 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xf8, 0x03, 0x00,
3807 0x0c, 0x03, 0x00, 0x04, 0xfe, 0x00, 0x06, 0x80, 0x00, 0xff, 0x9f, 0x00,
3808 0x03, 0x98, 0x00, 0x02, 0x90, 0x00, 0x06, 0xb0, 0x00, 0x04, 0xa0, 0x00,
3809 0x0c, 0xe0, 0x00, 0x08, 0xc0, 0x00, 0xf8, 0xff, 0x00, 0x00, 0x00, 0x00,
3810 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
3812 image create bitmap file_dir
-background white
-foreground blue \
3813 -data $file_dir_data -maskdata $file_dir_data
3816 set file_uplevel_data
{
3818 #define up_height 15
3819 static unsigned char up_bits
[] = {
3820 0x80, 0x00, 0xc0, 0x01, 0xe0, 0x03, 0xf0, 0x07, 0xf8, 0x0f, 0xfc, 0x1f,
3821 0xfe, 0x3f, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01, 0xc0, 0x01,
3822 0xc0, 0x01, 0xc0, 0x01, 0x00, 0x00};
3824 image create bitmap file_uplevel
-background white
-foreground red \
3825 -data $file_uplevel_data -maskdata $file_uplevel_data
3826 unset file_uplevel_data
3828 set ui_index .vpane.files.index.list
3829 set ui_workdir .vpane.files.workdir.list
3831 set all_icons
(_
$ui_index) file_plain
3832 set all_icons
(A
$ui_index) file_fulltick
3833 set all_icons
(M
$ui_index) file_fulltick
3834 set all_icons
(D
$ui_index) file_removed
3835 set all_icons
(U
$ui_index) file_merge
3837 set all_icons
(_
$ui_workdir) file_plain
3838 set all_icons
(M
$ui_workdir) file_mod
3839 set all_icons
(D
$ui_workdir) file_question
3840 set all_icons
(U
$ui_workdir) file_merge
3841 set all_icons
(O
$ui_workdir) file_plain
3843 set max_status_desc
0
3847 {_M
"Modified, not staged"}
3848 {M_
"Staged for commit"}
3849 {MM
"Portions staged for commit"}
3850 {MD
"Staged for commit, missing"}
3852 {_O
"Untracked, not staged"}
3853 {A_
"Staged for commit"}
3854 {AM
"Portions staged for commit"}
3855 {AD
"Staged for commit, missing"}
3858 {D_
"Staged for removal"}
3859 {DO
"Staged for removal, still present"}
3861 {U_
"Requires merge resolution"}
3862 {UU
"Requires merge resolution"}
3863 {UM
"Requires merge resolution"}
3864 {UD
"Requires merge resolution"}
3866 if {$max_status_desc < [string length
[lindex
$i 1]]} {
3867 set max_status_desc
[string length
[lindex
$i 1]]
3869 set all_descs
([lindex
$i 0]) [lindex
$i 1]
3873 ######################################################################
3877 proc bind_button3
{w cmd
} {
3878 bind $w <Any-Button-3
> $cmd
3880 bind $w <Control-Button-1
> $cmd
3884 proc scrollbar2many
{list mode args
} {
3885 foreach w
$list {eval $w $mode $args}
3888 proc many2scrollbar
{list mode sb top bottom
} {
3889 $sb set $top $bottom
3890 foreach w
$list {$w $mode moveto
$top}
3893 proc incr_font_size
{font
{amt
1}} {
3894 set sz
[font configure
$font -size]
3896 font configure
$font -size $sz
3897 font configure
${font}bold
-size $sz
3900 proc hook_failed_popup
{hook msg
} {
3905 label
$w.m.l1
-text "$hook hook failed:" \
3910 -background white
-borderwidth 1 \
3912 -width 80 -height 10 \
3914 -yscrollcommand [list
$w.m.sby
set]
3916 -text {You must correct the above errors before committing.
} \
3920 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3921 pack
$w.m.l1
-side top
-fill x
3922 pack
$w.m.l2
-side bottom
-fill x
3923 pack
$w.m.sby
-side right
-fill y
3924 pack
$w.m.t
-side left
-fill both
-expand 1
3925 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3927 $w.m.t insert
1.0 $msg
3928 $w.m.t conf
-state disabled
3930 button
$w.ok
-text OK \
3933 -command "destroy $w"
3934 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
3936 bind $w <Visibility
> "grab $w; focus $w"
3937 bind $w <Key-Return
> "destroy $w"
3938 wm title
$w "[appname] ([reponame]): error"
3942 set next_console_id
0
3944 proc new_console
{short_title long_title
} {
3945 global next_console_id console_data
3946 set w .console
[incr next_console_id
]
3947 set console_data
($w) [list
$short_title $long_title]
3948 return [console_init
$w]
3951 proc console_init
{w
} {
3952 global console_cr console_data M1B
3954 set console_cr
($w) 1.0
3957 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
3962 -background white
-borderwidth 1 \
3964 -width 80 -height 10 \
3967 -yscrollcommand [list
$w.m.sby
set]
3968 label
$w.m.s
-text {Working... please
wait...
} \
3972 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
3973 pack
$w.m.l1
-side top
-fill x
3974 pack
$w.m.s
-side bottom
-fill x
3975 pack
$w.m.sby
-side right
-fill y
3976 pack
$w.m.t
-side left
-fill both
-expand 1
3977 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
3979 menu
$w.ctxm
-tearoff 0
3980 $w.ctxm add
command -label "Copy" \
3982 -command "tk_textCopy $w.m.t"
3983 $w.ctxm add
command -label "Select All" \
3985 -command "focus $w.m.t;$w.m.t tag add sel 0.0 end"
3986 $w.ctxm add
command -label "Copy All" \
3989 $w.m.t tag add sel 0.0 end
3991 $w.m.t tag remove sel 0.0 end
3994 button
$w.ok
-text {Close
} \
3997 -command "destroy $w"
3998 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
4000 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
4001 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
4002 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
4003 bind $w <Visibility
> "focus $w"
4004 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
4008 proc console_exec
{w cmd after
} {
4009 # -- Cygwin's Tcl tosses the enviroment when we exec our child.
4010 # But most users need that so we have to relogin. :-(
4013 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
4016 # -- Tcl won't let us redirect both stdout and stderr to
4017 # the same pipe. So pass it through cat...
4019 set cmd
[concat |
$cmd |
& cat]
4021 set fd_f
[open
$cmd r
]
4022 fconfigure
$fd_f -blocking 0 -translation binary
4023 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
4026 proc console_read
{w fd after
} {
4031 if {![winfo exists
$w]} {console_init
$w}
4032 $w.m.t conf
-state normal
4034 set n
[string length
$buf]
4036 set cr
[string first
"\r" $buf $c]
4037 set lf
[string first
"\n" $buf $c]
4038 if {$cr < 0} {set cr
[expr {$n + 1}]}
4039 if {$lf < 0} {set lf
[expr {$n + 1}]}
4042 $w.m.t insert end
[string range
$buf $c $lf]
4043 set console_cr
($w) [$w.m.t index
{end
-1c}]
4047 $w.m.t delete
$console_cr($w) end
4048 $w.m.t insert end
"\n"
4049 $w.m.t insert end
[string range
$buf $c $cr]
4054 $w.m.t conf
-state disabled
4058 fconfigure
$fd -blocking 1
4060 if {[catch
{close
$fd}]} {
4065 uplevel
#0 $after $w $ok
4068 fconfigure
$fd -blocking 0
4071 proc console_chain
{cmdlist w
{ok
1}} {
4073 if {[llength
$cmdlist] == 0} {
4078 set cmd
[lindex
$cmdlist 0]
4079 set cmdlist
[lrange
$cmdlist 1 end
]
4081 if {[lindex
$cmd 0] eq
{console_exec
}} {
4084 [list console_chain
$cmdlist]
4086 uplevel
#0 $cmd $cmdlist $w $ok
4093 proc console_done
{args
} {
4094 global console_cr console_data
4096 switch
-- [llength
$args] {
4098 set w
[lindex
$args 0]
4099 set ok
[lindex
$args 1]
4102 set w
[lindex
$args 1]
4103 set ok
[lindex
$args 2]
4106 error
"wrong number of args: console_done ?ignored? w ok"
4111 if {[winfo exists
$w]} {
4112 $w.m.s conf
-background green
-text {Success
}
4113 $w.ok conf
-state normal
4116 if {![winfo exists
$w]} {
4119 $w.m.s conf
-background red
-text {Error
: Command Failed
}
4120 $w.ok conf
-state normal
4123 array
unset console_cr
$w
4124 array
unset console_data
$w
4127 ######################################################################
4131 set starting_gitk_msg
{Starting gitk... please
wait...
}
4133 proc do_gitk
{revs
} {
4134 global env ui_status_value starting_gitk_msg
4136 # -- Always start gitk through whatever we were loaded with. This
4137 # lets us bypass using shell process on Windows systems.
4139 set cmd
[info nameofexecutable
]
4140 lappend cmd
[gitexec gitk
]
4146 if {[catch
{eval exec $cmd &} err
]} {
4147 error_popup
"Failed to start gitk:\n\n$err"
4149 set ui_status_value
$starting_gitk_msg
4151 if {$ui_status_value eq
$starting_gitk_msg} {
4152 set ui_status_value
{Ready.
}
4159 set fd
[open
"| git count-objects -v" r
]
4160 while {[gets
$fd line
] > 0} {
4161 if {[regexp
{^
([^
:]+): (\d
+)$
} $line _ name value
]} {
4162 set stats
($name) $value
4168 foreach p
[glob
-directory [gitdir objects pack
] \
4171 incr packed_sz
[file size
$p]
4173 if {$packed_sz > 0} {
4174 set stats
(size-pack
) [expr {$packed_sz / 1024}]
4179 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4181 label
$w.header
-text {Database Statistics
} \
4183 pack
$w.header
-side top
-fill x
4185 frame
$w.buttons
-border 1
4186 button
$w.buttons.close
-text Close \
4188 -command [list destroy
$w]
4189 button
$w.buttons.gc
-text {Compress Database
} \
4191 -command "destroy $w;do_gc"
4192 pack
$w.buttons.close
-side right
4193 pack
$w.buttons.gc
-side left
4194 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4196 frame
$w.stat
-borderwidth 1 -relief solid
4198 {count
{Number of loose objects
}}
4199 {size
{Disk space used by loose objects
} { KiB
}}
4200 {in-pack
{Number of packed objects
}}
4201 {packs
{Number of packs
}}
4202 {size-pack
{Disk space used by packed objects
} { KiB
}}
4203 {prune-packable
{Packed objects waiting
for pruning
}}
4204 {garbage
{Garbage files
}}
4206 set name
[lindex
$s 0]
4207 set label
[lindex
$s 1]
4208 if {[catch
{set value
$stats($name)}]} continue
4209 if {[llength
$s] > 2} {
4210 set value
"$value[lindex $s 2]"
4213 label
$w.stat.l_
$name -text "$label:" -anchor w
-font font_ui
4214 label
$w.stat.v_
$name -text $value -anchor w
-font font_ui
4215 grid
$w.stat.l_
$name $w.stat.v_
$name -sticky we
-padx {0 5}
4217 pack
$w.stat
-pady 10 -padx 10
4219 bind $w <Visibility
> "grab $w; focus $w"
4220 bind $w <Key-Escape
> [list destroy
$w]
4221 bind $w <Key-Return
> [list destroy
$w]
4222 wm title
$w "[appname] ([reponame]): Database Statistics"
4227 set w
[new_console
{gc
} {Compressing the object database
}]
4229 {console_exec
{git pack-refs
--prune}}
4230 {console_exec
{git reflog expire
--all}}
4231 {console_exec
{git repack
-a -d -l}}
4232 {console_exec
{git rerere gc
}}
4236 proc do_fsck_objects
{} {
4237 set w
[new_console
{fsck-objects
} \
4238 {Verifying the object database with fsck-objects
}]
4239 set cmd
[list git fsck-objects
]
4242 lappend cmd
--strict
4243 console_exec
$w $cmd console_done
4249 global ui_comm is_quitting repo_config commit_type
4251 if {$is_quitting} return
4254 if {[winfo exists
$ui_comm]} {
4255 # -- Stash our current commit buffer.
4257 set save
[gitdir GITGUI_MSG
]
4258 set msg
[string trim
[$ui_comm get
0.0 end
]]
4259 regsub
-all -line {[ \r\t]+$
} $msg {} msg
4260 if {(![string match amend
* $commit_type]
4261 ||
[$ui_comm edit modified
])
4264 set fd
[open
$save w
]
4265 puts
-nonewline $fd $msg
4269 catch
{file delete
$save}
4272 # -- Stash our current window geometry into this repository.
4274 set cfg_geometry
[list
]
4275 lappend cfg_geometry
[wm geometry .
]
4276 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
4277 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
4278 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
4281 if {$cfg_geometry ne
$rc_geometry} {
4282 catch
{git config gui.geometry
$cfg_geometry}
4290 rescan
{set ui_status_value
{Ready.
}}
4293 proc unstage_helper
{txt paths
} {
4294 global file_states current_diff_path
4296 if {![lock_index begin-update
]} return
4300 foreach path
$paths {
4301 switch
-glob -- [lindex
$file_states($path) 0] {
4305 lappend pathList
$path
4306 if {$path eq
$current_diff_path} {
4307 set after
{reshow_diff
;}
4312 if {$pathList eq
{}} {
4318 [concat
$after {set ui_status_value
{Ready.
}}]
4322 proc do_unstage_selection
{} {
4323 global current_diff_path selected_paths
4325 if {[array size selected_paths
] > 0} {
4327 {Unstaging selected files from commit
} \
4328 [array names selected_paths
]
4329 } elseif
{$current_diff_path ne
{}} {
4331 "Unstaging [short_path $current_diff_path] from commit" \
4332 [list
$current_diff_path]
4336 proc add_helper
{txt paths
} {
4337 global file_states current_diff_path
4339 if {![lock_index begin-update
]} return
4343 foreach path
$paths {
4344 switch
-glob -- [lindex
$file_states($path) 0] {
4349 lappend pathList
$path
4350 if {$path eq
$current_diff_path} {
4351 set after
{reshow_diff
;}
4356 if {$pathList eq
{}} {
4362 [concat
$after {set ui_status_value
{Ready to commit.
}}]
4366 proc do_add_selection
{} {
4367 global current_diff_path selected_paths
4369 if {[array size selected_paths
] > 0} {
4371 {Adding selected files
} \
4372 [array names selected_paths
]
4373 } elseif
{$current_diff_path ne
{}} {
4375 "Adding [short_path $current_diff_path]" \
4376 [list
$current_diff_path]
4380 proc do_add_all
{} {
4384 foreach path
[array names file_states
] {
4385 switch
-glob -- [lindex
$file_states($path) 0] {
4388 ?D
{lappend paths
$path}
4391 add_helper
{Adding all changed files
} $paths
4394 proc revert_helper
{txt paths
} {
4395 global file_states current_diff_path
4397 if {![lock_index begin-update
]} return
4401 foreach path
$paths {
4402 switch
-glob -- [lindex
$file_states($path) 0] {
4406 lappend pathList
$path
4407 if {$path eq
$current_diff_path} {
4408 set after
{reshow_diff
;}
4414 set n
[llength
$pathList]
4418 } elseif
{$n == 1} {
4419 set s
"[short_path [lindex $pathList]]"
4421 set s
"these $n files"
4424 set reply
[tk_dialog \
4426 "[appname] ([reponame])" \
4427 "Revert changes in $s?
4429 Any unadded changes will be permanently lost by the revert." \
4439 [concat
$after {set ui_status_value
{Ready.
}}]
4445 proc do_revert_selection
{} {
4446 global current_diff_path selected_paths
4448 if {[array size selected_paths
] > 0} {
4450 {Reverting selected files
} \
4451 [array names selected_paths
]
4452 } elseif
{$current_diff_path ne
{}} {
4454 "Reverting [short_path $current_diff_path]" \
4455 [list
$current_diff_path]
4459 proc do_signoff
{} {
4462 set me
[committer_ident
]
4463 if {$me eq
{}} return
4465 set sob
"Signed-off-by: $me"
4466 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
4467 if {$last ne
$sob} {
4468 $ui_comm edit separator
4470 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
4471 $ui_comm insert end
"\n"
4473 $ui_comm insert end
"\n$sob"
4474 $ui_comm edit separator
4479 proc do_select_commit_type
{} {
4480 global commit_type selected_commit_type
4482 if {$selected_commit_type eq
{new
}
4483 && [string match amend
* $commit_type]} {
4485 } elseif
{$selected_commit_type eq
{amend
}
4486 && ![string match amend
* $commit_type]} {
4489 # The amend request was rejected...
4491 if {![string match amend
* $commit_type]} {
4492 set selected_commit_type new
4501 proc do_credits
{} {
4502 global gitgui_credits
4504 set w .credits_dialog
4507 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4509 label
$w.header
-text {git-gui Contributors
} -font font_uibold
4510 pack
$w.header
-side top
-fill x
4513 button
$w.buttons.close
-text {Close
} \
4515 -command [list destroy
$w]
4516 pack
$w.buttons.close
-side right
4517 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4521 -background [$w.header cget
-background] \
4522 -yscrollcommand [list
$w.credits.sby
set] \
4530 scrollbar
$w.credits.sby
-command [list
$w.credits.t yview
]
4531 pack
$w.credits.sby
-side right
-fill y
4532 pack
$w.credits.t
-fill both
-expand 1
4533 pack
$w.credits
-side top
-fill both
-expand 1 -padx 5 -pady 5
4536 -text "All portions are copyrighted by their respective authors
4537 and are distributed under the GNU General Public License." \
4544 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4546 $w.credits.t insert end
"[string trim $gitgui_credits]\n"
4547 $w.credits.t conf
-state disabled
4548 $w.credits.t see
1.0
4550 bind $w <Visibility
> "grab $w; focus $w"
4551 bind $w <Key-Escape
> [list destroy
$w]
4552 wm title
$w [$w.header cget
-text]
4557 global appvers copyright
4558 global tcl_patchLevel tk_patchLevel
4562 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4564 label
$w.header
-text "About [appname]" \
4566 pack
$w.header
-side top
-fill x
4569 button
$w.buttons.close
-text {Close
} \
4571 -command [list destroy
$w]
4572 button
$w.buttons.credits
-text {Contributors
} \
4575 pack
$w.buttons.credits
-side left
4576 pack
$w.buttons.close
-side right
4577 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4580 -text "git-gui - a graphical user interface for Git.
4588 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
4591 append v
"git-gui version $appvers\n"
4592 append v
"[git version]\n"
4594 if {$tcl_patchLevel eq
$tk_patchLevel} {
4595 append v
"Tcl/Tk version $tcl_patchLevel"
4597 append v
"Tcl version $tcl_patchLevel"
4598 append v
", Tk version $tk_patchLevel"
4609 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
4611 menu
$w.ctxm
-tearoff 0
4612 $w.ctxm add
command \
4617 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
4620 bind $w <Visibility
> "grab $w; focus $w"
4621 bind $w <Key-Escape
> "destroy $w"
4622 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
4623 wm title
$w "About [appname]"
4627 proc do_options
{} {
4628 global repo_config global_config font_descs
4629 global repo_config_new global_config_new
4631 array
unset repo_config_new
4632 array
unset global_config_new
4633 foreach name
[array names repo_config
] {
4634 set repo_config_new
($name) $repo_config($name)
4637 foreach name
[array names repo_config
] {
4639 gui.diffcontext
{continue}
4641 set repo_config_new
($name) $repo_config($name)
4643 foreach name
[array names global_config
] {
4644 set global_config_new
($name) $global_config($name)
4647 set w .options_editor
4649 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
4651 label
$w.header
-text "Options" \
4653 pack
$w.header
-side top
-fill x
4656 button
$w.buttons.restore
-text {Restore Defaults
} \
4658 -command do_restore_defaults
4659 pack
$w.buttons.restore
-side left
4660 button
$w.buttons.save
-text Save \
4662 -command [list do_save_config
$w]
4663 pack
$w.buttons.save
-side right
4664 button
$w.buttons.cancel
-text {Cancel
} \
4666 -command [list destroy
$w]
4667 pack
$w.buttons.cancel
-side right
-padx 5
4668 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
4670 labelframe
$w.repo
-text "[reponame] Repository" \
4672 labelframe
$w.global
-text {Global
(All Repositories
)} \
4674 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
4675 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
4679 {t user.name
{User Name
}}
4680 {t user.email
{Email Address
}}
4682 {b merge.summary
{Summarize Merge Commits
}}
4683 {i-1.
.5 merge.verbosity
{Merge Verbosity
}}
4685 {b gui.trustmtime
{Trust File Modification Timestamps
}}
4686 {i-1.
.99 gui.diffcontext
{Number of Diff Context Lines
}}
4687 {t gui.newbranchtemplate
{New Branch Name Template
}}
4689 set type [lindex
$option 0]
4690 set name
[lindex
$option 1]
4691 set text
[lindex
$option 2]
4693 foreach f
{repo global
} {
4694 switch
-glob -- $type {
4696 checkbutton
$w.
$f.
$optid -text $text \
4697 -variable ${f}_config_new
($name) \
4701 pack
$w.
$f.
$optid -side top
-anchor w
4704 regexp
-- {-(\d
+)\.\.
(\d
+)$
} $type _junk min max
4706 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4707 pack
$w.
$f.
$optid.l
-side left
-anchor w
-fill x
4708 spinbox
$w.
$f.
$optid.v \
4709 -textvariable ${f}_config_new
($name) \
4713 -width [expr {1 + [string length
$max]}] \
4715 bind $w.
$f.
$optid.v
<FocusIn
> {%W selection range
0 end
}
4716 pack
$w.
$f.
$optid.v
-side right
-anchor e
-padx 5
4717 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4721 label
$w.
$f.
$optid.l
-text "$text:" -font font_ui
4722 entry
$w.
$f.
$optid.v \
4726 -textvariable ${f}_config_new
($name) \
4728 pack
$w.
$f.
$optid.l
-side left
-anchor w
4729 pack
$w.
$f.
$optid.v
-side left
-anchor w \
4732 pack
$w.
$f.
$optid -side top
-anchor w
-fill x
4738 set all_fonts
[lsort
[font families
]]
4739 foreach option
$font_descs {
4740 set name
[lindex
$option 0]
4741 set font
[lindex
$option 1]
4742 set text
[lindex
$option 2]
4744 set global_config_new
(gui.
$font^^family
) \
4745 [font configure
$font -family]
4746 set global_config_new
(gui.
$font^^size
) \
4747 [font configure
$font -size]
4749 frame
$w.global.
$name
4750 label
$w.global.
$name.l
-text "$text:" -font font_ui
4751 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
4752 eval tk_optionMenu
$w.global.
$name.family \
4753 global_config_new
(gui.
$font^^family
) \
4755 spinbox
$w.global.
$name.size \
4756 -textvariable global_config_new
(gui.
$font^^size
) \
4757 -from 2 -to 80 -increment 1 \
4760 bind $w.global.
$name.size
<FocusIn
> {%W selection range
0 end
}
4761 pack
$w.global.
$name.size
-side right
-anchor e
4762 pack
$w.global.
$name.family
-side right
-anchor e
4763 pack
$w.global.
$name -side top
-anchor w
-fill x
4766 bind $w <Visibility
> "grab $w; focus $w"
4767 bind $w <Key-Escape
> "destroy $w"
4768 wm title
$w "[appname] ([reponame]): Options"
4772 proc do_restore_defaults
{} {
4773 global font_descs default_config repo_config
4774 global repo_config_new global_config_new
4776 foreach name
[array names default_config
] {
4777 set repo_config_new
($name) $default_config($name)
4778 set global_config_new
($name) $default_config($name)
4781 foreach option
$font_descs {
4782 set name
[lindex
$option 0]
4783 set repo_config
(gui.
$name) $default_config(gui.
$name)
4787 foreach option
$font_descs {
4788 set name
[lindex
$option 0]
4789 set font
[lindex
$option 1]
4790 set global_config_new
(gui.
$font^^family
) \
4791 [font configure
$font -family]
4792 set global_config_new
(gui.
$font^^size
) \
4793 [font configure
$font -size]
4797 proc do_save_config
{w
} {
4798 if {[catch
{save_config
} err
]} {
4799 error_popup
"Failed to completely save options:\n\n$err"
4805 proc do_windows_shortcut
{} {
4808 set fn
[tk_getSaveFile \
4810 -title "[appname] ([reponame]): Create Desktop Icon" \
4811 -initialfile "Git [reponame].bat"]
4815 puts
$fd "@ECHO Entering [reponame]"
4816 puts
$fd "@ECHO Starting git-gui... please wait..."
4817 puts
$fd "@SET PATH=[file normalize [gitexec]];%PATH%"
4818 puts
$fd "@SET GIT_DIR=[file normalize [gitdir]]"
4819 puts
-nonewline $fd "@\"[info nameofexecutable]\""
4820 puts
$fd " \"[file normalize $argv0]\""
4823 error_popup
"Cannot write script:\n\n$err"
4828 proc do_cygwin_shortcut
{} {
4832 set desktop
[exec cygpath \
4840 set fn
[tk_getSaveFile \
4842 -title "[appname] ([reponame]): Create Desktop Icon" \
4843 -initialdir $desktop \
4844 -initialfile "Git [reponame].bat"]
4848 set sh
[exec cygpath \
4852 set me
[exec cygpath \
4856 set gd
[exec cygpath \
4860 set gw
[exec cygpath \
4863 [file dirname [gitdir
]]]
4864 regsub
-all ' $me "'\\''" me
4865 regsub -all ' $gd "'\\''" gd
4866 puts $fd "@ECHO Entering $gw"
4867 puts $fd "@ECHO Starting git-gui... please wait..."
4868 puts -nonewline $fd "@\"$sh\" --login -c \""
4869 puts -nonewline $fd "GIT_DIR='$gd'"
4870 puts -nonewline $fd " '$me'"
4874 error_popup "Cannot write script:\n\n$err"
4879 proc do_macosx_app {} {
4882 set fn [tk_getSaveFile \
4884 -title "[appname] ([reponame]): Create Desktop Icon" \
4885 -initialdir [file join $env(HOME) Desktop] \
4886 -initialfile "Git [reponame].app"]
4889 set Contents [file join $fn Contents]
4890 set MacOS [file join $Contents MacOS]
4891 set exe [file join $MacOS git-gui]
4895 set fd [open [file join $Contents Info.plist] w]
4896 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
4897 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
4898 <plist version="1.0">
4900 <key>CFBundleDevelopmentRegion</key>
4901 <string>English</string>
4902 <key>CFBundleExecutable</key>
4903 <string>git-gui</string>
4904 <key>CFBundleIdentifier</key>
4905 <string>org.spearce.git-gui</string>
4906 <key>CFBundleInfoDictionaryVersion</key>
4907 <string>6.0</string>
4908 <key>CFBundlePackageType</key>
4909 <string>APPL</string>
4910 <key>CFBundleSignature</key>
4911 <string>????</string>
4912 <key>CFBundleVersion</key>
4913 <string>1.0</string>
4914 <key>NSPrincipalClass</key>
4915 <string>NSApplication</string>
4920 set fd [open $exe w]
4921 set gd [file normalize [gitdir]]
4922 set ep [file normalize [gitexec]]
4923 regsub -all ' $gd "'\\''" gd
4924 regsub
-all ' $ep "'\\''" ep
4925 puts $fd "#!/bin/sh"
4926 foreach name
[array names env
] {
4927 if {[string match GIT_
* $name]} {
4928 regsub
-all ' $env($name) "'\\''" v
4929 puts $fd "export $name='$v'"
4932 puts $fd "export PATH
='$ep':\
$PATH"
4933 puts $fd "export GIT_DIR
='$gd'"
4934 puts $fd "exec [file normalize
$argv0]"
4937 file attributes $exe -permissions u+x,g+x,o+x
4939 error_popup "Cannot
write icon
:\n\n$err"
4944 proc toggle_or_diff {w x y} {
4945 global file_states file_lists current_diff_path ui_index ui_workdir
4946 global last_clicked selected_paths
4948 set pos [split [$w index @$x,$y] .]
4949 set lno [lindex $pos 0]
4950 set col [lindex $pos 1]
4951 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4957 set last_clicked [list $w $lno]
4958 array unset selected_paths
4959 $ui_index tag remove in_sel 0.0 end
4960 $ui_workdir tag remove in_sel 0.0 end
4963 if {$current_diff_path eq $path} {
4964 set after {reshow_diff;}
4968 if {$w eq $ui_index} {
4970 "Unstaging
[short_path
$path] from commit
" \
4972 [concat $after {set ui_status_value {Ready.}}]
4973 } elseif {$w eq $ui_workdir} {
4975 "Adding
[short_path
$path]" \
4977 [concat $after {set ui_status_value {Ready.}}]
4980 show_diff $path $w $lno
4984 proc add_one_to_selection {w x y} {
4985 global file_lists last_clicked selected_paths
4987 set lno [lindex [split [$w index @$x,$y] .] 0]
4988 set path [lindex $file_lists($w) [expr {$lno - 1}]]
4994 if {$last_clicked ne {}
4995 && [lindex $last_clicked 0] ne $w} {
4996 array unset selected_paths
4997 [lindex $last_clicked 0] tag remove in_sel 0.0 end
5000 set last_clicked [list $w $lno]
5001 if {[catch {set in_sel $selected_paths($path)}]} {
5005 unset selected_paths($path)
5006 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
5008 set selected_paths($path) 1
5009 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
5013 proc add_range_to_selection {w x y} {
5014 global file_lists last_clicked selected_paths
5016 if {[lindex $last_clicked 0] ne $w} {
5017 toggle_or_diff $w $x $y
5021 set lno [lindex [split [$w index @$x,$y] .] 0]
5022 set lc [lindex $last_clicked 1]
5031 foreach path [lrange $file_lists($w) \
5032 [expr {$begin - 1}] \
5033 [expr {$end - 1}]] {
5034 set selected_paths($path) 1
5036 $w tag add in_sel $begin.0 [expr {$end + 1}].0
5039 ######################################################################
5043 set cursor_ptr arrow
5044 font create font_diff -family Courier -size 10
5048 eval font configure font_ui [font actual [.dummy cget -font]]
5052 font create font_uibold
5053 font create font_diffbold
5058 } elseif {[is_MacOSX]} {
5066 proc apply_config {} {
5067 global repo_config font_descs
5069 foreach option $font_descs {
5070 set name [lindex $option 0]
5071 set font [lindex $option 1]
5073 foreach {cn cv} $repo_config(gui.$name) {
5074 font configure $font $cn $cv
5077 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
5079 foreach {cn cv} [font configure $font] {
5080 font configure ${font}bold $cn $cv
5082 font configure ${font}bold -weight bold
5086 set default_config(merge.summary) false
5087 set default_config(merge.verbosity) 2
5088 set default_config(user.name) {}
5089 set default_config(user.email) {}
5091 set default_config(gui.trustmtime) false
5092 set default_config(gui.diffcontext) 5
5093 set default_config(gui.newbranchtemplate) {}
5094 set default_config(gui.fontui) [font configure font_ui]
5095 set default_config(gui.fontdiff) [font configure font_diff]
5097 {fontui font_ui {Main Font}}
5098 {fontdiff font_diff {Diff/Console Font}}
5103 ######################################################################
5105 ## feature option selection
5107 if {[regexp {^git-(.+)$} [appname] _junk subcommand]} {
5112 if {$subcommand eq {gui.sh}} {
5115 if {$subcommand eq {gui} && [llength $argv] > 0} {
5116 set subcommand [lindex $argv 0]
5117 set argv [lrange $argv 1 end]
5120 enable_option multicommit
5121 enable_option branch
5122 enable_option transport
5124 switch -- $subcommand {
5129 disable_option multicommit
5130 disable_option branch
5131 disable_option transport
5134 enable_option singlecommit
5136 disable_option multicommit
5137 disable_option branch
5138 disable_option transport
5142 ######################################################################
5150 menu .mbar -tearoff 0
5151 .mbar add cascade -label Repository -menu .mbar.repository
5152 .mbar add cascade -label Edit -menu .mbar.edit
5153 if {[is_enabled branch]} {
5154 .mbar add cascade -label Branch -menu .mbar.branch
5156 if {[is_enabled multicommit] || [is_enabled singlecommit]} {
5157 .mbar add cascade -label Commit -menu .mbar.commit
5159 if {[is_enabled transport]} {
5160 .mbar add cascade -label Merge -menu .mbar.merge
5161 .mbar add cascade -label Fetch -menu .mbar.fetch
5162 .mbar add cascade -label Push -menu .mbar.push
5164 . configure -menu .mbar
5166 # -- Repository Menu
5168 menu .mbar.repository
5170 .mbar.repository add command \
5171 -label {Browse Current Branch} \
5172 -command {new_browser $current_branch} \
5174 trace add variable current_branch write ".mbar.repository entryconf
[.mbar.repository index last
] -label \"Browse \
$current_branch\" ;#"
5175 .mbar.repository add separator
5177 .mbar.repository add
command \
5178 -label {Visualize Current Branch
} \
5179 -command {do_gitk
$current_branch} \
5181 trace add variable current_branch
write ".mbar.repository entryconf [.mbar.repository index last] -label \"Visualize \$current_branch\" ;#"
5182 .mbar.repository add
command \
5183 -label {Visualize All Branches
} \
5184 -command {do_gitk
--all} \
5186 .mbar.repository add separator
5188 if {[is_enabled multicommit
]} {
5189 .mbar.repository add
command -label {Database Statistics
} \
5193 .mbar.repository add
command -label {Compress Database
} \
5197 .mbar.repository add
command -label {Verify Database
} \
5198 -command do_fsck_objects \
5201 .mbar.repository add separator
5204 .mbar.repository add
command \
5205 -label {Create Desktop Icon
} \
5206 -command do_cygwin_shortcut \
5208 } elseif
{[is_Windows
]} {
5209 .mbar.repository add
command \
5210 -label {Create Desktop Icon
} \
5211 -command do_windows_shortcut \
5213 } elseif
{[is_MacOSX
]} {
5214 .mbar.repository add
command \
5215 -label {Create Desktop Icon
} \
5216 -command do_macosx_app \
5221 .mbar.repository add
command -label Quit \
5223 -accelerator $M1T-Q \
5229 .mbar.edit add
command -label Undo \
5230 -command {catch
{[focus
] edit undo
}} \
5231 -accelerator $M1T-Z \
5233 .mbar.edit add
command -label Redo \
5234 -command {catch
{[focus
] edit redo
}} \
5235 -accelerator $M1T-Y \
5237 .mbar.edit add separator
5238 .mbar.edit add
command -label Cut \
5239 -command {catch
{tk_textCut
[focus
]}} \
5240 -accelerator $M1T-X \
5242 .mbar.edit add
command -label Copy \
5243 -command {catch
{tk_textCopy
[focus
]}} \
5244 -accelerator $M1T-C \
5246 .mbar.edit add
command -label Paste \
5247 -command {catch
{tk_textPaste
[focus
]; [focus
] see insert
}} \
5248 -accelerator $M1T-V \
5250 .mbar.edit add
command -label Delete \
5251 -command {catch
{[focus
] delete sel.first sel.last
}} \
5254 .mbar.edit add separator
5255 .mbar.edit add
command -label {Select All
} \
5256 -command {catch
{[focus
] tag add sel
0.0 end
}} \
5257 -accelerator $M1T-A \
5262 if {[is_enabled branch
]} {
5265 .mbar.branch add
command -label {Create...
} \
5266 -command do_create_branch \
5267 -accelerator $M1T-N \
5269 lappend disable_on_lock
[list .mbar.branch entryconf \
5270 [.mbar.branch index last
] -state]
5272 .mbar.branch add
command -label {Delete...
} \
5273 -command do_delete_branch \
5275 lappend disable_on_lock
[list .mbar.branch entryconf \
5276 [.mbar.branch index last
] -state]
5278 .mbar.branch add
command -label {Reset...
} \
5279 -command do_reset_hard \
5281 lappend disable_on_lock
[list .mbar.branch entryconf \
5282 [.mbar.branch index last
] -state]
5287 if {[is_enabled multicommit
] ||
[is_enabled singlecommit
]} {
5290 .mbar.commit add radiobutton \
5291 -label {New Commit
} \
5292 -command do_select_commit_type \
5293 -variable selected_commit_type \
5296 lappend disable_on_lock \
5297 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5299 .mbar.commit add radiobutton \
5300 -label {Amend Last Commit
} \
5301 -command do_select_commit_type \
5302 -variable selected_commit_type \
5305 lappend disable_on_lock \
5306 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5308 .mbar.commit add separator
5310 .mbar.commit add
command -label Rescan \
5311 -command do_rescan \
5314 lappend disable_on_lock \
5315 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5317 .mbar.commit add
command -label {Add To Commit
} \
5318 -command do_add_selection \
5320 lappend disable_on_lock \
5321 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5323 .mbar.commit add
command -label {Add Existing To Commit
} \
5324 -command do_add_all \
5325 -accelerator $M1T-I \
5327 lappend disable_on_lock \
5328 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5330 .mbar.commit add
command -label {Unstage From Commit
} \
5331 -command do_unstage_selection \
5333 lappend disable_on_lock \
5334 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5336 .mbar.commit add
command -label {Revert Changes
} \
5337 -command do_revert_selection \
5339 lappend disable_on_lock \
5340 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5342 .mbar.commit add separator
5344 .mbar.commit add
command -label {Sign Off
} \
5345 -command do_signoff \
5346 -accelerator $M1T-S \
5349 .mbar.commit add
command -label Commit \
5350 -command do_commit \
5351 -accelerator $M1T-Return \
5353 lappend disable_on_lock \
5354 [list .mbar.commit entryconf
[.mbar.commit index last
] -state]
5359 if {[is_enabled branch
]} {
5361 .mbar.merge add
command -label {Local Merge...
} \
5362 -command do_local_merge \
5364 lappend disable_on_lock \
5365 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5366 .mbar.merge add
command -label {Abort Merge...
} \
5367 -command do_reset_hard \
5369 lappend disable_on_lock \
5370 [list .mbar.merge entryconf
[.mbar.merge index last
] -state]
5376 if {[is_enabled transport
]} {
5380 .mbar.push add
command -label {Push...
} \
5381 -command do_push_anywhere \
5386 # -- Apple Menu (Mac OS X only)
5388 .mbar add cascade
-label Apple
-menu .mbar.apple
5391 .mbar.apple add
command -label "About [appname]" \
5394 .mbar.apple add
command -label "Options..." \
5395 -command do_options \
5400 .mbar.edit add separator
5401 .mbar.edit add
command -label {Options...
} \
5402 -command do_options \
5407 if {[file exists
/usr
/local
/miga
/lib
/gui-miga
]
5408 && [file exists .pvcsrc
]} {
5410 global ui_status_value
5411 if {![lock_index update
]} return
5412 set cmd
[list sh
--login -c "/usr/local/miga/lib/gui-miga \"[pwd]\""]
5413 set miga_fd
[open
"|$cmd" r
]
5414 fconfigure
$miga_fd -blocking 0
5415 fileevent
$miga_fd readable
[list miga_done
$miga_fd]
5416 set ui_status_value
{Running miga...
}
5418 proc miga_done
{fd
} {
5423 rescan
[list
set ui_status_value
{Ready.
}]
5426 .mbar add cascade
-label Tools
-menu .mbar.tools
5428 .mbar.tools add
command -label "Migrate" \
5431 lappend disable_on_lock \
5432 [list .mbar.tools entryconf
[.mbar.tools index last
] -state]
5438 .mbar add cascade
-label Help
-menu .mbar.
help
5442 .mbar.
help add
command -label "About [appname]" \
5448 catch
{set browser
$repo_config(instaweb.browser
)}
5449 set doc_path
[file dirname [gitexec
]]
5450 set doc_path
[file join $doc_path Documentation index.html
]
5453 set doc_path
[exec cygpath
--mixed $doc_path]
5456 if {$browser eq
{}} {
5459 } elseif
{[is_Cygwin
]} {
5460 set program_files
[file dirname [exec cygpath
--windir]]
5461 set program_files
[file join $program_files {Program Files
}]
5462 set firefox
[file join $program_files {Mozilla Firefox
} firefox.exe
]
5463 set ie
[file join $program_files {Internet Explorer
} IEXPLORE.EXE
]
5464 if {[file exists
$firefox]} {
5465 set browser
$firefox
5466 } elseif
{[file exists
$ie]} {
5469 unset program_files firefox ie
5473 if {[file isfile
$doc_path]} {
5474 set doc_url
"file:$doc_path"
5476 set doc_url
{http
://www.kernel.org
/pub
/software
/scm
/git
/docs
/}
5479 if {$browser ne
{}} {
5480 .mbar.
help add
command -label {Online Documentation
} \
5481 -command [list
exec $browser $doc_url &] \
5484 unset browser doc_path doc_url
5486 # -- Standard bindings
5488 bind .
<Destroy
> do_quit
5489 bind all
<$M1B-Key-q> do_quit
5490 bind all
<$M1B-Key-Q> do_quit
5491 bind all
<$M1B-Key-w> {destroy
[winfo toplevel
%W
]}
5492 bind all
<$M1B-Key-W> {destroy
[winfo toplevel
%W
]}
5494 # -- Not a normal commit type invocation? Do that instead!
5496 switch
-- $subcommand {
5499 puts
"git-gui version $appvers"
5503 if {[llength
$argv] != 1} {
5504 puts stderr
"usage: $argv0 browser commit"
5507 set current_branch
[lindex
$argv 0]
5508 new_browser
$current_branch
5512 if {[llength
$argv] != 2} {
5513 puts stderr
"usage: $argv0 blame commit path"
5516 set current_branch
[lindex
$argv 0]
5517 show_blame
$current_branch [lindex
$argv 1]
5522 if {[llength
$argv] != 0} {
5523 puts
-nonewline stderr
"usage: $argv0"
5524 if {$subcommand ne
{gui
} && [appname
] ne
"git-$subcommand"} {
5525 puts
-nonewline stderr
" $subcommand"
5530 # fall through to setup UI for commits
5533 puts stderr
"usage: $argv0 \[{blame|browser|citool}\]"
5544 -text {Current Branch
:} \
5549 -textvariable current_branch \
5553 pack .branch.l1
-side left
5554 pack .branch.cb
-side left
-fill x
5555 pack .branch
-side top
-fill x
5557 # -- Main Window Layout
5559 panedwindow .vpane
-orient vertical
5560 panedwindow .vpane.files
-orient horizontal
5561 .vpane add .vpane.files
-sticky nsew
-height 100 -width 200
5562 pack .vpane
-anchor n
-side top
-fill both
-expand 1
5564 # -- Index File List
5566 frame .vpane.files.index
-height 100 -width 200
5567 label .vpane.files.index.title
-text {Changes To Be Committed
} \
5570 text
$ui_index -background white
-borderwidth 0 \
5571 -width 20 -height 10 \
5574 -cursor $cursor_ptr \
5575 -xscrollcommand {.vpane.files.index.sx
set} \
5576 -yscrollcommand {.vpane.files.index.sy
set} \
5578 scrollbar .vpane.files.index.sx
-orient h
-command [list
$ui_index xview
]
5579 scrollbar .vpane.files.index.sy
-orient v
-command [list
$ui_index yview
]
5580 pack .vpane.files.index.title
-side top
-fill x
5581 pack .vpane.files.index.sx
-side bottom
-fill x
5582 pack .vpane.files.index.sy
-side right
-fill y
5583 pack
$ui_index -side left
-fill both
-expand 1
5584 .vpane.files add .vpane.files.index
-sticky nsew
5586 # -- Working Directory File List
5588 frame .vpane.files.workdir
-height 100 -width 200
5589 label .vpane.files.workdir.title
-text {Changed But Not Updated
} \
5592 text
$ui_workdir -background white
-borderwidth 0 \
5593 -width 20 -height 10 \
5596 -cursor $cursor_ptr \
5597 -xscrollcommand {.vpane.files.workdir.sx
set} \
5598 -yscrollcommand {.vpane.files.workdir.sy
set} \
5600 scrollbar .vpane.files.workdir.sx
-orient h
-command [list
$ui_workdir xview
]
5601 scrollbar .vpane.files.workdir.sy
-orient v
-command [list
$ui_workdir yview
]
5602 pack .vpane.files.workdir.title
-side top
-fill x
5603 pack .vpane.files.workdir.sx
-side bottom
-fill x
5604 pack .vpane.files.workdir.sy
-side right
-fill y
5605 pack
$ui_workdir -side left
-fill both
-expand 1
5606 .vpane.files add .vpane.files.workdir
-sticky nsew
5608 foreach i
[list
$ui_index $ui_workdir] {
5609 $i tag conf in_diff
-font font_uibold
5610 $i tag conf in_sel \
5611 -background [$i cget
-foreground] \
5612 -foreground [$i cget
-background]
5616 # -- Diff and Commit Area
5618 frame .vpane.lower
-height 300 -width 400
5619 frame .vpane.lower.commarea
5620 frame .vpane.lower.
diff -relief sunken
-borderwidth 1
5621 pack .vpane.lower.commarea
-side top
-fill x
5622 pack .vpane.lower.
diff -side bottom
-fill both
-expand 1
5623 .vpane add .vpane.lower
-sticky nsew
5625 # -- Commit Area Buttons
5627 frame .vpane.lower.commarea.buttons
5628 label .vpane.lower.commarea.buttons.l
-text {} \
5632 pack .vpane.lower.commarea.buttons.l
-side top
-fill x
5633 pack .vpane.lower.commarea.buttons
-side left
-fill y
5635 button .vpane.lower.commarea.buttons.rescan
-text {Rescan
} \
5636 -command do_rescan \
5638 pack .vpane.lower.commarea.buttons.rescan
-side top
-fill x
5639 lappend disable_on_lock \
5640 {.vpane.lower.commarea.buttons.rescan conf
-state}
5642 button .vpane.lower.commarea.buttons.incall
-text {Add Existing
} \
5643 -command do_add_all \
5645 pack .vpane.lower.commarea.buttons.incall
-side top
-fill x
5646 lappend disable_on_lock \
5647 {.vpane.lower.commarea.buttons.incall conf
-state}
5649 button .vpane.lower.commarea.buttons.signoff
-text {Sign Off
} \
5650 -command do_signoff \
5652 pack .vpane.lower.commarea.buttons.signoff
-side top
-fill x
5654 button .vpane.lower.commarea.buttons.commit
-text {Commit
} \
5655 -command do_commit \
5657 pack .vpane.lower.commarea.buttons.commit
-side top
-fill x
5658 lappend disable_on_lock \
5659 {.vpane.lower.commarea.buttons.commit conf
-state}
5661 # -- Commit Message Buffer
5663 frame .vpane.lower.commarea.buffer
5664 frame .vpane.lower.commarea.buffer.header
5665 set ui_comm .vpane.lower.commarea.buffer.t
5666 set ui_coml .vpane.lower.commarea.buffer.header.l
5667 radiobutton .vpane.lower.commarea.buffer.header.new \
5668 -text {New Commit
} \
5669 -command do_select_commit_type \
5670 -variable selected_commit_type \
5673 lappend disable_on_lock \
5674 [list .vpane.lower.commarea.buffer.header.new conf
-state]
5675 radiobutton .vpane.lower.commarea.buffer.header.amend \
5676 -text {Amend Last Commit
} \
5677 -command do_select_commit_type \
5678 -variable selected_commit_type \
5681 lappend disable_on_lock \
5682 [list .vpane.lower.commarea.buffer.header.amend conf
-state]
5687 proc trace_commit_type
{varname args
} {
5688 global ui_coml commit_type
5689 switch
-glob -- $commit_type {
5690 initial
{set txt
{Initial Commit Message
:}}
5691 amend
{set txt
{Amended Commit Message
:}}
5692 amend-initial
{set txt
{Amended Initial Commit Message
:}}
5693 amend-merge
{set txt
{Amended Merge Commit Message
:}}
5694 merge
{set txt
{Merge Commit Message
:}}
5695 * {set txt
{Commit Message
:}}
5697 $ui_coml conf
-text $txt
5699 trace add variable commit_type
write trace_commit_type
5700 pack
$ui_coml -side left
-fill x
5701 pack .vpane.lower.commarea.buffer.header.amend
-side right
5702 pack .vpane.lower.commarea.buffer.header.new
-side right
5704 text
$ui_comm -background white
-borderwidth 1 \
5707 -autoseparators true \
5709 -width 75 -height 9 -wrap none \
5711 -yscrollcommand {.vpane.lower.commarea.buffer.sby
set}
5712 scrollbar .vpane.lower.commarea.buffer.sby \
5713 -command [list
$ui_comm yview
]
5714 pack .vpane.lower.commarea.buffer.header
-side top
-fill x
5715 pack .vpane.lower.commarea.buffer.sby
-side right
-fill y
5716 pack
$ui_comm -side left
-fill y
5717 pack .vpane.lower.commarea.buffer
-side left
-fill y
5719 # -- Commit Message Buffer Context Menu
5721 set ctxm .vpane.lower.commarea.buffer.ctxm
5722 menu
$ctxm -tearoff 0
5726 -command {tk_textCut
$ui_comm}
5730 -command {tk_textCopy
$ui_comm}
5734 -command {tk_textPaste
$ui_comm}
5738 -command {$ui_comm delete sel.first sel.last
}
5741 -label {Select All
} \
5743 -command {focus
$ui_comm;$ui_comm tag add sel
0.0 end
}
5748 $ui_comm tag add sel
0.0 end
5749 tk_textCopy
$ui_comm
5750 $ui_comm tag remove sel
0.0 end
5757 bind_button3
$ui_comm "tk_popup $ctxm %X %Y"
5761 proc trace_current_diff_path
{varname args
} {
5762 global current_diff_path diff_actions file_states
5763 if {$current_diff_path eq
{}} {
5769 set p
$current_diff_path
5770 set s
[mapdesc
[lindex
$file_states($p) 0] $p]
5772 set p
[escape_path
$p]
5776 .vpane.lower.
diff.header.status configure
-text $s
5777 .vpane.lower.
diff.header.
file configure
-text $f
5778 .vpane.lower.
diff.header.path configure
-text $p
5779 foreach w
$diff_actions {
5783 trace add variable current_diff_path
write trace_current_diff_path
5785 frame .vpane.lower.
diff.header
-background orange
5786 label .vpane.lower.
diff.header.status \
5787 -background orange \
5788 -width $max_status_desc \
5792 label .vpane.lower.
diff.header.
file \
5793 -background orange \
5797 label .vpane.lower.
diff.header.path \
5798 -background orange \
5802 pack .vpane.lower.
diff.header.status
-side left
5803 pack .vpane.lower.
diff.header.
file -side left
5804 pack .vpane.lower.
diff.header.path
-fill x
5805 set ctxm .vpane.lower.
diff.header.ctxm
5806 menu
$ctxm -tearoff 0
5815 -- $current_diff_path
5817 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5818 bind_button3 .vpane.lower.
diff.header.path
"tk_popup $ctxm %X %Y"
5822 frame .vpane.lower.
diff.body
5823 set ui_diff .vpane.lower.
diff.body.t
5824 text
$ui_diff -background white
-borderwidth 0 \
5825 -width 80 -height 15 -wrap none \
5827 -xscrollcommand {.vpane.lower.
diff.body.sbx
set} \
5828 -yscrollcommand {.vpane.lower.
diff.body.sby
set} \
5830 scrollbar .vpane.lower.
diff.body.sbx
-orient horizontal \
5831 -command [list
$ui_diff xview
]
5832 scrollbar .vpane.lower.
diff.body.sby
-orient vertical \
5833 -command [list
$ui_diff yview
]
5834 pack .vpane.lower.
diff.body.sbx
-side bottom
-fill x
5835 pack .vpane.lower.
diff.body.sby
-side right
-fill y
5836 pack
$ui_diff -side left
-fill both
-expand 1
5837 pack .vpane.lower.
diff.header
-side top
-fill x
5838 pack .vpane.lower.
diff.body
-side bottom
-fill both
-expand 1
5840 $ui_diff tag conf d_cr
-elide true
5841 $ui_diff tag conf d_@
-foreground blue
-font font_diffbold
5842 $ui_diff tag conf d_
+ -foreground {#00a000}
5843 $ui_diff tag conf d_-
-foreground red
5845 $ui_diff tag conf d_
++ -foreground {#00a000}
5846 $ui_diff tag conf d_--
-foreground red
5847 $ui_diff tag conf d_
+s \
5848 -foreground {#00a000} \
5849 -background {#e2effa}
5850 $ui_diff tag conf d_-s \
5852 -background {#e2effa}
5853 $ui_diff tag conf d_s
+ \
5854 -foreground {#00a000} \
5856 $ui_diff tag conf d_s- \
5860 $ui_diff tag conf d
<<<<<<< \
5861 -foreground orange \
5863 $ui_diff tag conf d
======= \
5864 -foreground orange \
5866 $ui_diff tag conf d
>>>>>>> \
5867 -foreground orange \
5870 $ui_diff tag raise sel
5872 # -- Diff Body Context Menu
5874 set ctxm .vpane.lower.
diff.body.ctxm
5875 menu
$ctxm -tearoff 0
5879 -command reshow_diff
5880 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5884 -command {tk_textCopy
$ui_diff}
5885 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5887 -label {Select All
} \
5889 -command {focus
$ui_diff;$ui_diff tag add sel
0.0 end
}
5890 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5895 $ui_diff tag add sel
0.0 end
5896 tk_textCopy
$ui_diff
5897 $ui_diff tag remove sel
0.0 end
5899 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5902 -label {Apply
/Reverse Hunk
} \
5904 -command {apply_hunk
$cursorX $cursorY}
5905 set ui_diff_applyhunk
[$ctxm index last
]
5906 lappend diff_actions
[list
$ctxm entryconf
$ui_diff_applyhunk -state]
5909 -label {Decrease Font Size
} \
5911 -command {incr_font_size font_diff
-1}
5912 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5914 -label {Increase Font Size
} \
5916 -command {incr_font_size font_diff
1}
5917 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5920 -label {Show Less Context
} \
5922 -command {if {$repo_config(gui.diffcontext
) >= 2} {
5923 incr repo_config
(gui.diffcontext
) -1
5926 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5928 -label {Show More Context
} \
5931 incr repo_config
(gui.diffcontext
)
5934 lappend diff_actions
[list
$ctxm entryconf
[$ctxm index last
] -state]
5936 $ctxm add
command -label {Options...
} \
5939 bind_button3
$ui_diff "
5942 if {\$ui_index eq \$current_diff_side} {
5943 $ctxm entryconf $ui_diff_applyhunk -label {Unstage Hunk From Commit}
5945 $ctxm entryconf $ui_diff_applyhunk -label {Stage Hunk For Commit}
5947 tk_popup $ctxm %X %Y
5949 unset ui_diff_applyhunk
5953 label .status
-textvariable ui_status_value \
5959 pack .status
-anchor w
-side bottom
-fill x
5964 set gm
$repo_config(gui.geometry
)
5965 wm geometry .
[lindex
$gm 0]
5966 .vpane sash place
0 \
5967 [lindex
[.vpane sash coord
0] 0] \
5969 .vpane.files sash place
0 \
5971 [lindex
[.vpane.files sash coord
0] 1]
5977 bind $ui_comm <$M1B-Key-Return> {do_commit
;break}
5978 bind $ui_comm <$M1B-Key-i> {do_add_all
;break}
5979 bind $ui_comm <$M1B-Key-I> {do_add_all
;break}
5980 bind $ui_comm <$M1B-Key-x> {tk_textCut
%W
;break}
5981 bind $ui_comm <$M1B-Key-X> {tk_textCut
%W
;break}
5982 bind $ui_comm <$M1B-Key-c> {tk_textCopy
%W
;break}
5983 bind $ui_comm <$M1B-Key-C> {tk_textCopy
%W
;break}
5984 bind $ui_comm <$M1B-Key-v> {tk_textPaste
%W
; %W see insert
; break}
5985 bind $ui_comm <$M1B-Key-V> {tk_textPaste
%W
; %W see insert
; break}
5986 bind $ui_comm <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5987 bind $ui_comm <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5989 bind $ui_diff <$M1B-Key-x> {tk_textCopy
%W
;break}
5990 bind $ui_diff <$M1B-Key-X> {tk_textCopy
%W
;break}
5991 bind $ui_diff <$M1B-Key-c> {tk_textCopy
%W
;break}
5992 bind $ui_diff <$M1B-Key-C> {tk_textCopy
%W
;break}
5993 bind $ui_diff <$M1B-Key-v> {break}
5994 bind $ui_diff <$M1B-Key-V> {break}
5995 bind $ui_diff <$M1B-Key-a> {%W tag add sel
0.0 end
;break}
5996 bind $ui_diff <$M1B-Key-A> {%W tag add sel
0.0 end
;break}
5997 bind $ui_diff <Key-Up
> {catch
{%W yview scroll
-1 units
};break}
5998 bind $ui_diff <Key-Down
> {catch
{%W yview scroll
1 units
};break}
5999 bind $ui_diff <Key-Left
> {catch
{%W xview scroll
-1 units
};break}
6000 bind $ui_diff <Key-Right
> {catch
{%W xview scroll
1 units
};break}
6001 bind $ui_diff <Button-1
> {focus
%W
}
6003 if {[is_enabled branch
]} {
6004 bind .
<$M1B-Key-n> do_create_branch
6005 bind .
<$M1B-Key-N> do_create_branch
6008 bind all
<Key-F5
> do_rescan
6009 bind all
<$M1B-Key-r> do_rescan
6010 bind all
<$M1B-Key-R> do_rescan
6011 bind .
<$M1B-Key-s> do_signoff
6012 bind .
<$M1B-Key-S> do_signoff
6013 bind .
<$M1B-Key-i> do_add_all
6014 bind .
<$M1B-Key-I> do_add_all
6015 bind .
<$M1B-Key-Return> do_commit
6016 foreach i
[list
$ui_index $ui_workdir] {
6017 bind $i <Button-1
> "toggle_or_diff $i %x %y; break"
6018 bind $i <$M1B-Button-1> "add_one_to_selection $i %x %y; break"
6019 bind $i <Shift-Button-1
> "add_range_to_selection $i %x %y; break"
6023 set file_lists
($ui_index) [list
]
6024 set file_lists
($ui_workdir) [list
]
6026 wm title .
"[appname] ([file normalize [file dirname [gitdir]]])"
6027 focus
-force $ui_comm
6029 # -- Warn the user about environmental problems. Cygwin's Tcl
6030 # does *not* pass its env array onto any processes it spawns.
6031 # This means that git processes get none of our environment.
6036 set msg
"Possible environment issues exist.
6038 The following environment variables are probably
6039 going to be ignored by any Git subprocess run
6043 foreach name
[array names env
] {
6044 switch
-regexp -- $name {
6045 {^GIT_INDEX_FILE$
} -
6046 {^GIT_OBJECT_DIRECTORY$
} -
6047 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$
} -
6049 {^GIT_EXTERNAL_DIFF$
} -
6053 {^GIT_CONFIG_LOCAL$
} -
6054 {^GIT_
(AUTHOR|COMMITTER
)_DATE$
} {
6055 append msg
" - $name\n"
6058 {^GIT_
(AUTHOR|COMMITTER
)_
(NAME|EMAIL
)$
} {
6059 append msg
" - $name\n"
6061 set suggest_user
$name
6065 if {$ignored_env > 0} {
6067 This is due to a known issue with the
6068 Tcl binary distributed by Cygwin."
6070 if {$suggest_user ne
{}} {
6073 A good replacement for $suggest_user
6074 is placing values for the user.name and
6075 user.email settings into your personal
6081 unset ignored_env msg suggest_user name
6084 # -- Only initialize complex UI if we are going to stay running.
6086 if {[is_enabled transport
]} {
6090 populate_branch_menu
6095 # -- Only suggest a gc run if we are going to stay running.
6097 if {[is_enabled multicommit
]} {
6098 set object_limit
2000
6099 if {[is_Windows
]} {set object_limit
200}
6100 regexp
{^
([0-9]+) objects
,} [git count-objects
] _junk objects_current
6101 if {$objects_current >= $object_limit} {
6103 "This repository currently has $objects_current loose objects.
6105 To maintain optimal performance it is strongly
6106 recommended that you compress the database
6107 when more than $object_limit loose objects exist.
6109 Compress the database now?"] eq
yes} {
6113 unset object_limit _junk objects_current
6116 lock_index begin-read