2 # Tcl ignores the next line -*- tcl -*- \
5 set appvers
{@@GIT_VERSION@@
}
7 Copyright ©
2006, 2007 Shawn Pearce
, Paul Mackerras.
9 This program is free software
; you can redistribute it and
/or modify
10 it under the terms of the GNU General Public License as published by
11 the Free Software Foundation
; either version
2 of the License
, or
12 (at your option
) any later version.
14 This program is distributed
in the hope that it will be useful
,
15 but WITHOUT ANY WARRANTY
; without even the implied warranty of
16 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
17 GNU General Public License
for more details.
19 You should have received a copy of the GNU General Public License
20 along with this program
; if not
, write to the Free Software
21 Foundation
, Inc.
, 59 Temple Place
, Suite
330, Boston
, MA
02111-1307 USA
}
23 ######################################################################
27 set _appname
[lindex
[file split $argv0] end
]
41 return [eval [concat
[list
file join $_gitdir] $args]]
49 ######################################################################
53 proc is_many_config
{name
} {
54 switch
-glob -- $name {
63 proc load_config
{include_global
} {
64 global repo_config global_config default_config
66 array
unset global_config
67 if {$include_global} {
69 set fd_rc
[open
"| git repo-config --global --list" r
]
70 while {[gets
$fd_rc line
] >= 0} {
71 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
72 if {[is_many_config
$name]} {
73 lappend global_config
($name) $value
75 set global_config
($name) $value
83 array
unset repo_config
85 set fd_rc
[open
"| git repo-config --list" r
]
86 while {[gets
$fd_rc line
] >= 0} {
87 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
88 if {[is_many_config
$name]} {
89 lappend repo_config
($name) $value
91 set repo_config
($name) $value
98 foreach name
[array names default_config
] {
99 if {[catch
{set v
$global_config($name)}]} {
100 set global_config
($name) $default_config($name)
102 if {[catch
{set v
$repo_config($name)}]} {
103 set repo_config
($name) $default_config($name)
108 proc save_config
{} {
109 global default_config font_descs
110 global repo_config global_config
111 global repo_config_new global_config_new
113 foreach option
$font_descs {
114 set name
[lindex
$option 0]
115 set font
[lindex
$option 1]
116 font configure
$font \
117 -family $global_config_new(gui.
$font^^family
) \
118 -size $global_config_new(gui.
$font^^size
)
119 font configure
${font}bold \
120 -family $global_config_new(gui.
$font^^family
) \
121 -size $global_config_new(gui.
$font^^size
)
122 set global_config_new
(gui.
$name) [font configure
$font]
123 unset global_config_new
(gui.
$font^^family
)
124 unset global_config_new
(gui.
$font^^size
)
127 foreach name
[array names default_config
] {
128 set value
$global_config_new($name)
129 if {$value ne
$global_config($name)} {
130 if {$value eq
$default_config($name)} {
131 catch
{exec git repo-config
--global --unset $name}
133 regsub
-all "\[{}\]" $value {"} value
134 exec git repo-config --global $name $value
136 set global_config($name) $value
137 if {$value eq $repo_config($name)} {
138 catch {exec git repo-config --unset $name}
139 set repo_config($name) $value
144 foreach name [array names default_config] {
145 set value $repo_config_new($name)
146 if {$value ne $repo_config($name)} {
147 if {$value eq $global_config($name)} {
148 catch {exec git repo-config --unset $name}
150 regsub -all "\
[{}\
]" $value {"} value
151 exec git repo-config
$name $value
153 set repo_config
($name) $value
158 proc error_popup
{msg
} {
160 if {[reponame
] ne
{}} {
161 append title
" ([reponame])"
163 set cmd
[list tk_messageBox \
166 -title "$title: error" \
168 if {[winfo ismapped .
]} {
169 lappend cmd
-parent .
174 proc warn_popup
{msg
} {
176 if {[reponame
] ne
{}} {
177 append title
" ([reponame])"
179 set cmd
[list tk_messageBox \
182 -title "$title: warning" \
184 if {[winfo ismapped .
]} {
185 lappend cmd
-parent .
190 proc info_popup
{msg
} {
192 if {[reponame
] ne
{}} {
193 append title
" ([reponame])"
203 proc ask_popup
{msg
} {
205 if {[reponame
] ne
{}} {
206 append title
" ([reponame])"
208 return [tk_messageBox \
216 ######################################################################
220 if { [catch
{set _gitdir
$env(GIT_DIR
)}]
221 && [catch
{set _gitdir
[exec git rev-parse
--git-dir]} err
]} {
222 catch
{wm withdraw .
}
223 error_popup
"Cannot find the git directory:\n\n$err"
226 if {![file isdirectory
$_gitdir]} {
227 catch
{wm withdraw .
}
228 error_popup
"Git directory not found:\n\n$_gitdir"
231 if {[lindex
[file split $_gitdir] end
] ne
{.git
}} {
232 catch
{wm withdraw .
}
233 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
236 if {[catch
{cd [file dirname $_gitdir]} err
]} {
237 catch
{wm withdraw .
}
238 error_popup
"No working directory [file dirname $_gitdir]:\n\n$err"
241 set _reponame
[lindex
[file split \
242 [file normalize
[file dirname $_gitdir]]] \
246 if {[appname
] eq
{git-citool
}} {
250 ######################################################################
258 set disable_on_lock
[list
]
259 set index_lock_type none
261 proc lock_index
{type} {
262 global index_lock_type disable_on_lock
264 if {$index_lock_type eq
{none
}} {
265 set index_lock_type
$type
266 foreach w
$disable_on_lock {
267 uplevel
#0 $w disabled
270 } elseif
{$index_lock_type eq
"begin-$type"} {
271 set index_lock_type
$type
277 proc unlock_index
{} {
278 global index_lock_type disable_on_lock
280 set index_lock_type none
281 foreach w
$disable_on_lock {
286 ######################################################################
290 proc repository_state
{ctvar hdvar mhvar
} {
291 global current_branch
292 upvar
$ctvar ct
$hdvar hd
$mhvar mh
296 if {[catch
{set current_branch
[exec git symbolic-ref HEAD
]}]} {
297 set current_branch
{}
299 regsub ^refs
/((heads|tags|remotes
)/)? \
305 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
311 set merge_head
[gitdir MERGE_HEAD
]
312 if {[file exists
$merge_head]} {
314 set fd_mh
[open
$merge_head r
]
315 while {[gets
$fd_mh line
] >= 0} {
326 global PARENT empty_tree
328 set p
[lindex
$PARENT 0]
332 if {$empty_tree eq
{}} {
333 set empty_tree
[exec git mktree
<< {}]
338 proc rescan
{after
} {
339 global HEAD PARENT MERGE_HEAD commit_type
340 global ui_index ui_other ui_status_value ui_comm
341 global rescan_active file_states
344 if {$rescan_active > 0 ||
![lock_index
read]} return
346 repository_state newType newHEAD newMERGE_HEAD
347 if {[string match amend
* $commit_type]
348 && $newType eq
{normal
}
349 && $newHEAD eq
$HEAD} {
353 set MERGE_HEAD
$newMERGE_HEAD
354 set commit_type
$newType
357 array
unset file_states
359 if {![$ui_comm edit modified
]
360 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
361 if {[load_message GITGUI_MSG
]} {
362 } elseif
{[load_message MERGE_MSG
]} {
363 } elseif
{[load_message SQUASH_MSG
]} {
366 $ui_comm edit modified false
369 if {$repo_config(gui.trustmtime
) eq
{true
}} {
370 rescan_stage2
{} $after
373 set ui_status_value
{Refreshing
file status...
}
374 set cmd
[list git update-index
]
376 lappend cmd
--unmerged
377 lappend cmd
--ignore-missing
378 lappend cmd
--refresh
379 set fd_rf
[open
"| $cmd" r
]
380 fconfigure
$fd_rf -blocking 0 -translation binary
381 fileevent
$fd_rf readable \
382 [list rescan_stage2
$fd_rf $after]
386 proc rescan_stage2
{fd after
} {
387 global ui_status_value
388 global rescan_active buf_rdi buf_rdf buf_rlo
392 if {![eof
$fd]} return
396 set ls_others
[list | git ls-files
--others -z \
397 --exclude-per-directory=.gitignore
]
398 set info_exclude
[gitdir info exclude
]
399 if {[file readable
$info_exclude]} {
400 lappend ls_others
"--exclude-from=$info_exclude"
408 set ui_status_value
{Scanning
for modified files ...
}
409 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
410 set fd_df
[open
"| git diff-files -z" r
]
411 set fd_lo
[open
$ls_others r
]
413 fconfigure
$fd_di -blocking 0 -translation binary
414 fconfigure
$fd_df -blocking 0 -translation binary
415 fconfigure
$fd_lo -blocking 0 -translation binary
416 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
417 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
418 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
421 proc load_message
{file} {
425 if {[file isfile
$f]} {
426 if {[catch
{set fd
[open
$f r
]}]} {
429 set content
[string trim
[read $fd]]
431 $ui_comm delete
0.0 end
432 $ui_comm insert end
$content
438 proc read_diff_index
{fd after
} {
441 append buf_rdi
[read $fd]
443 set n
[string length
$buf_rdi]
445 set z1
[string first
"\0" $buf_rdi $c]
448 set z2
[string first
"\0" $buf_rdi $z1]
452 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
454 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
456 [list
[lindex
$i 0] [lindex
$i 2]] \
462 set buf_rdi
[string range
$buf_rdi $c end
]
467 rescan_done
$fd buf_rdi
$after
470 proc read_diff_files
{fd after
} {
473 append buf_rdf
[read $fd]
475 set n
[string length
$buf_rdf]
477 set z1
[string first
"\0" $buf_rdf $c]
480 set z2
[string first
"\0" $buf_rdf $z1]
484 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
486 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
489 [list
[lindex
$i 0] [lindex
$i 2]]
494 set buf_rdf
[string range
$buf_rdf $c end
]
499 rescan_done
$fd buf_rdf
$after
502 proc read_ls_others
{fd after
} {
505 append buf_rlo
[read $fd]
506 set pck
[split $buf_rlo "\0"]
507 set buf_rlo
[lindex
$pck end
]
508 foreach p
[lrange
$pck 0 end-1
] {
511 rescan_done
$fd buf_rlo
$after
514 proc rescan_done
{fd buf after
} {
516 global file_states repo_config
519 if {![eof
$fd]} return
522 if {[incr rescan_active
-1] > 0} return
528 if {$repo_config(gui.partialinclude
) ne
{true
}} {
530 foreach path
[array names file_states
] {
531 switch
-- [lindex
$file_states($path) 0] {
533 M?
{lappend pathList
$path}
536 if {$pathList ne
{}} {
538 "Updating included files" \
540 [concat
{reshow_diff
;} $after]
549 proc prune_selection
{} {
550 global file_states selected_paths
552 foreach path
[array names selected_paths
] {
553 if {[catch
{set still_here
$file_states($path)}]} {
554 unset selected_paths
($path)
559 ######################################################################
564 global ui_diff current_diff ui_index ui_other
566 $ui_diff conf
-state normal
567 $ui_diff delete
0.0 end
568 $ui_diff conf
-state disabled
572 $ui_index tag remove in_diff
0.0 end
573 $ui_other tag remove in_diff
0.0 end
576 proc reshow_diff
{} {
577 global current_diff ui_status_value file_states
579 if {$current_diff eq
{}
580 ||
[catch
{set s
$file_states($current_diff)}]} {
583 show_diff
$current_diff
587 proc handle_empty_diff
{} {
588 global current_diff file_states file_lists
590 set path
$current_diff
591 set s
$file_states($path)
592 if {[lindex
$s 0] ne
{_M
}} return
594 info_popup
"No differences detected.
596 [short_path $path] has no changes.
598 The modification date of this file was updated
599 by another application and you currently have
600 the Trust File Modification Timestamps option
601 enabled, so Git did not automatically detect
602 that there are no content differences in this
605 This file will now be removed from the modified
606 files list, to prevent possible confusion.
608 if {[catch
{exec git update-index
-- $path} err
]} {
609 error_popup
"Failed to refresh index:\n\n$err"
613 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
614 set lno
[lsearch
-sorted $file_lists($old_w) $path]
616 set file_lists
($old_w) \
617 [lreplace
$file_lists($old_w) $lno $lno]
619 $old_w conf
-state normal
620 $old_w delete
$lno.0 [expr {$lno + 1}].0
621 $old_w conf
-state disabled
625 proc show_diff
{path
{w
{}} {lno
{}}} {
626 global file_states file_lists
627 global is_3way_diff diff_active repo_config
628 global ui_diff current_diff ui_status_value
630 if {$diff_active ||
![lock_index
read]} return
633 if {$w eq
{} ||
$lno == {}} {
634 foreach w
[array names file_lists
] {
635 set lno
[lsearch
-sorted $file_lists($w) $path]
642 if {$w ne
{} && $lno >= 1} {
643 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
646 set s
$file_states($path)
650 set current_diff
$path
651 set ui_status_value
"Loading diff of [escape_path $path]..."
653 set cmd
[list | git diff-index
]
654 lappend cmd
--no-color
655 if {$repo_config(gui.diffcontext
) > 0} {
656 lappend cmd
"-U$repo_config(gui.diffcontext)"
666 set fd
[open
$path r
]
667 set content
[read $fd]
672 set ui_status_value
"Unable to display [escape_path $path]"
673 error_popup
"Error loading file:\n\n$err"
676 $ui_diff conf
-state normal
677 $ui_diff insert end
$content
678 $ui_diff conf
-state disabled
681 set ui_status_value
{Ready.
}
690 if {[catch
{set fd
[open
$cmd r
]} err
]} {
693 set ui_status_value
"Unable to display [escape_path $path]"
694 error_popup
"Error loading diff:\n\n$err"
698 fconfigure
$fd -blocking 0 -translation auto
699 fileevent
$fd readable
[list read_diff
$fd]
702 proc read_diff
{fd
} {
703 global ui_diff ui_status_value is_3way_diff diff_active
706 $ui_diff conf
-state normal
707 while {[gets
$fd line
] >= 0} {
708 # -- Cleanup uninteresting diff header lines.
710 if {[string match
{diff --git *} $line]} continue
711 if {[string match
{diff --combined *} $line]} continue
712 if {[string match
{--- *} $line]} continue
713 if {[string match
{+++ *} $line]} continue
714 if {$line eq
{deleted
file mode
120000}} {
715 set line
"deleted symlink"
718 # -- Automatically detect if this is a 3 way diff.
720 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
722 # -- Reformat a 3 way diff, 'cause its too weird.
725 set op
[string range
$line 0 1]
728 {++} {set tags d_
+ ; set op
{ +}}
729 {--} {set tags d_-
; set op
{ -}}
730 { +} {set tags d_
++; set op
{++}}
731 { -} {set tags d_--
; set op
{--}}
732 {+ } {set tags d_-
+; set op
{-+}}
733 {- } {set tags d_
+-; set op
{+-}}
734 default
{set tags
{}}
736 set line
[string replace
$line 0 1 $op]
738 switch
-- [string index
$line 0] {
742 default
{set tags
{}}
745 $ui_diff insert end
$line $tags
746 $ui_diff insert end
"\n" $tags
748 $ui_diff conf
-state disabled
754 set ui_status_value
{Ready.
}
756 if {$repo_config(gui.trustmtime
) eq
{true
}
757 && [$ui_diff index end
] eq
{2.0}} {
763 ######################################################################
767 proc load_last_commit
{} {
768 global HEAD PARENT MERGE_HEAD commit_type ui_comm
770 if {[llength
$PARENT] == 0} {
771 error_popup
{There is nothing to amend.
773 You are about to create the initial commit.
774 There is no commit before this to amend.
779 repository_state curType curHEAD curMERGE_HEAD
780 if {$curType eq
{merge
}} {
781 error_popup
{Cannot amend
while merging.
783 You are currently
in the middle of a merge that
784 has not been fully completed. You cannot amend
785 the prior commit unless you first abort the
786 current merge activity.
794 set fd
[open
"| git cat-file commit $curHEAD" r
]
795 while {[gets
$fd line
] > 0} {
796 if {[string match
{parent
*} $line]} {
797 lappend parents
[string range
$line 7 end
]
800 set msg
[string trim
[read $fd]]
803 error_popup
"Error loading commit data for amend:\n\n$err"
809 set MERGE_HEAD
[list
]
810 switch
-- [llength
$parents] {
811 0 {set commit_type amend-initial
}
812 1 {set commit_type amend
}
813 default
{set commit_type amend-merge
}
816 $ui_comm delete
0.0 end
817 $ui_comm insert end
$msg
819 $ui_comm edit modified false
820 rescan
{set ui_status_value
{Ready.
}}
823 proc create_new_commit
{} {
824 global commit_type ui_comm
826 set commit_type normal
827 $ui_comm delete
0.0 end
829 $ui_comm edit modified false
830 rescan
{set ui_status_value
{Ready.
}}
833 set GIT_COMMITTER_IDENT
{}
835 proc committer_ident
{} {
836 global GIT_COMMITTER_IDENT
838 if {$GIT_COMMITTER_IDENT eq
{}} {
839 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
840 error_popup
"Unable to obtain your identity:\n\n$err"
843 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
844 $me me GIT_COMMITTER_IDENT
]} {
845 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
850 return $GIT_COMMITTER_IDENT
853 proc commit_tree
{} {
854 global HEAD commit_type file_states ui_comm repo_config
856 if {![lock_index update
]} return
857 if {[committer_ident
] eq
{}} return
859 # -- Our in memory state should match the repository.
861 repository_state curType curHEAD curMERGE_HEAD
862 if {[string match amend
* $commit_type]
863 && $curType eq
{normal
}
864 && $curHEAD eq
$HEAD} {
865 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
866 info_popup
{Last scanned state does not match repository state.
868 Another Git program has modified this repository
869 since the last scan. A rescan must be performed
870 before another commit can be created.
872 The rescan will be automatically started now.
875 rescan
{set ui_status_value
{Ready.
}}
879 # -- At least one file should differ in the index.
882 foreach path
[array names file_states
] {
883 switch
-glob -- [lindex
$file_states($path) 0] {
887 M?
{set files_ready
1; break}
889 error_popup
"Unmerged files cannot be committed.
891 File [short_path $path] has merge conflicts.
892 You must resolve them and include the file before committing.
898 error_popup
"Unknown file state [lindex $s 0] detected.
900 File [short_path $path] cannot be committed by this program.
906 error_popup
{No included files to commit.
908 You must include
at least
1 file before you can commit.
914 # -- A message is required.
916 set msg
[string trim
[$ui_comm get
1.0 end
]]
918 error_popup
{Please supply a commit message.
920 A good commit message has the following format
:
922 - First line
: Describe
in one sentance what you did.
924 - Remaining lines
: Describe why this change is good.
930 # -- Update included files if partialincludes are off.
932 if {$repo_config(gui.partialinclude
) ne
{true
}} {
934 foreach path
[array names file_states
] {
935 switch
-glob -- [lindex
$file_states($path) 0] {
937 M?
{lappend pathList
$path}
940 if {$pathList ne
{}} {
943 "Updating included files" \
945 [concat
{lock_index update
;} \
946 [list commit_prehook
$curHEAD $msg]]
951 commit_prehook
$curHEAD $msg
954 proc commit_prehook
{curHEAD msg
} {
955 global ui_status_value pch_error
957 set pchook
[gitdir hooks pre-commit
]
959 # On Cygwin [file executable] might lie so we need to ask
960 # the shell if the hook is executable. Yes that's annoying.
962 if {[is_Windows
] && [file isfile
$pchook]} {
963 set pchook
[list sh
-c [concat \
964 "if test -x \"$pchook\";" \
965 "then exec \"$pchook\" 2>&1;" \
967 } elseif
{[file executable
$pchook]} {
968 set pchook
[list
$pchook |
& cat]
970 commit_writetree
$curHEAD $msg
974 set ui_status_value
{Calling pre-commit hook...
}
976 set fd_ph
[open
"| $pchook" r
]
977 fconfigure
$fd_ph -blocking 0 -translation binary
978 fileevent
$fd_ph readable \
979 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
982 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
983 global pch_error ui_status_value
985 append pch_error
[read $fd_ph]
986 fconfigure
$fd_ph -blocking 1
988 if {[catch
{close
$fd_ph}]} {
989 set ui_status_value
{Commit declined by pre-commit hook.
}
990 hook_failed_popup pre-commit
$pch_error
993 commit_writetree
$curHEAD $msg
998 fconfigure
$fd_ph -blocking 0
1001 proc commit_writetree
{curHEAD msg
} {
1002 global ui_status_value
1004 set ui_status_value
{Committing changes...
}
1005 set fd_wt
[open
"| git write-tree" r
]
1006 fileevent
$fd_wt readable \
1007 [list commit_committree
$fd_wt $curHEAD $msg]
1010 proc commit_committree
{fd_wt curHEAD msg
} {
1011 global HEAD PARENT MERGE_HEAD commit_type
1012 global single_commit
1013 global ui_status_value ui_comm selected_commit_type
1014 global file_states selected_paths rescan_active
1017 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
1018 error_popup
"write-tree failed:\n\n$err"
1019 set ui_status_value
{Commit failed.
}
1024 # -- Create the commit.
1026 set cmd
[list git commit-tree
$tree_id]
1027 set parents
[concat
$PARENT $MERGE_HEAD]
1028 if {[llength
$parents] > 0} {
1029 foreach p
$parents {
1033 # git commit-tree writes to stderr during initial commit.
1034 lappend cmd
2>/dev
/null
1037 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
1038 error_popup
"commit-tree failed:\n\n$err"
1039 set ui_status_value
{Commit failed.
}
1044 # -- Update the HEAD ref.
1047 if {$commit_type ne
{normal
}} {
1048 append reflogm
" ($commit_type)"
1050 set i
[string first
"\n" $msg]
1052 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
1054 append reflogm
{: } $msg
1056 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
1057 if {[catch
{eval exec $cmd} err
]} {
1058 error_popup
"update-ref failed:\n\n$err"
1059 set ui_status_value
{Commit failed.
}
1064 # -- Cleanup after ourselves.
1066 catch
{file delete
[gitdir MERGE_HEAD
]}
1067 catch
{file delete
[gitdir MERGE_MSG
]}
1068 catch
{file delete
[gitdir SQUASH_MSG
]}
1069 catch
{file delete
[gitdir GITGUI_MSG
]}
1071 # -- Let rerere do its thing.
1073 if {[file isdirectory
[gitdir rr-cache
]]} {
1074 catch
{exec git rerere
}
1077 # -- Run the post-commit hook.
1079 set pchook
[gitdir hooks post-commit
]
1080 if {[is_Windows
] && [file isfile
$pchook]} {
1081 set pchook
[list sh
-c [concat \
1082 "if test -x \"$pchook\";" \
1083 "then exec \"$pchook\";" \
1085 } elseif
{![file executable
$pchook]} {
1088 if {$pchook ne
{}} {
1089 catch
{exec $pchook &}
1092 $ui_comm delete
0.0 end
1094 $ui_comm edit modified false
1096 if {$single_commit} do_quit
1098 # -- Update in memory status
1100 set selected_commit_type new
1101 set commit_type normal
1104 set MERGE_HEAD
[list
]
1106 foreach path
[array names file_states
] {
1107 set s
$file_states($path)
1109 switch
-glob -- $m {
1117 unset file_states
($path)
1118 catch
{unset selected_paths
($path)}
1121 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1128 set file_states
($path) [list \
1129 _
[string index
$m 1] \
1140 set ui_status_value \
1141 "Changes committed as [string range $cmt_id 0 7]."
1144 ######################################################################
1148 proc fetch_from
{remote
} {
1149 set w
[new_console
"fetch $remote" \
1150 "Fetching new changes from $remote"]
1151 set cmd
[list git fetch
]
1153 console_exec
$w $cmd
1156 proc pull_remote
{remote branch
} {
1157 global HEAD commit_type file_states repo_config
1159 if {![lock_index update
]} return
1161 # -- Our in memory state should match the repository.
1163 repository_state curType curHEAD curMERGE_HEAD
1164 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1165 info_popup
{Last scanned state does not match repository state.
1167 Another Git program has modified this repository
1168 since the last scan. A rescan must be performed
1169 before a pull operation can be started.
1171 The rescan will be automatically started now.
1174 rescan
{set ui_status_value
{Ready.
}}
1178 # -- No differences should exist before a pull.
1180 if {[array size file_states
] != 0} {
1181 error_popup
{Uncommitted but modified files are present.
1183 You should not perform a pull with unmodified
1184 files
in your working directory as Git will be
1185 unable to recover from an incorrect merge.
1187 You should commit or revert all changes before
1188 starting a pull operation.
1194 set w
[new_console
"pull $remote $branch" \
1195 "Pulling new changes from branch $branch in $remote"]
1196 set cmd
[list git pull
]
1197 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1198 lappend cmd
--no-summary
1202 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1205 proc post_pull_remote
{remote branch success
} {
1206 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1207 global ui_status_value
1211 repository_state commit_type HEAD MERGE_HEAD
1213 set selected_commit_type new
1214 set ui_status_value
"Pulling $branch from $remote complete."
1216 rescan
[list
set ui_status_value \
1217 "Conflicts detected while pulling $branch from $remote."]
1221 proc push_to
{remote
} {
1222 set w
[new_console
"push $remote" \
1223 "Pushing changes to $remote"]
1224 set cmd
[list git push
]
1226 console_exec
$w $cmd
1229 ######################################################################
1233 proc mapcol
{state path
} {
1234 global all_cols ui_other
1236 if {[catch
{set r
$all_cols($state)}]} {
1237 puts
"error: no column for state={$state} $path"
1243 proc mapicon
{state path
} {
1246 if {[catch
{set r
$all_icons($state)}]} {
1247 puts
"error: no icon for state={$state} $path"
1253 proc mapdesc
{state path
} {
1256 if {[catch
{set r
$all_descs($state)}]} {
1257 puts
"error: no desc for state={$state} $path"
1263 proc escape_path
{path
} {
1264 regsub
-all "\n" $path "\\n" path
1268 proc short_path
{path
} {
1269 return [escape_path
[lindex
[file split $path] end
]]
1273 set null_sha1
[string repeat
0 40]
1275 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1276 global file_states next_icon_id null_sha1
1278 set s0
[string index
$new_state 0]
1279 set s1
[string index
$new_state 1]
1281 if {[catch
{set info
$file_states($path)}]} {
1283 set icon n
[incr next_icon_id
]
1285 set state
[lindex
$info 0]
1286 set icon
[lindex
$info 1]
1287 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1288 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1291 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1292 elseif
{$s0 eq
{_
}} {set s0 _
}
1294 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1295 elseif
{$s1 eq
{_
}} {set s1 _
}
1297 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1298 set head_info
[list
0 $null_sha1]
1299 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1300 && $head_info eq
{}} {
1301 set head_info
$index_info
1304 set file_states
($path) [list
$s0$s1 $icon \
1305 $head_info $index_info \
1310 proc display_file
{path state
} {
1311 global file_states file_lists selected_paths
1313 set old_m
[merge_state
$path $state]
1314 set s
$file_states($path)
1315 set new_m
[lindex
$s 0]
1316 set new_w
[mapcol
$new_m $path]
1317 set old_w
[mapcol
$old_m $path]
1318 set new_icon
[mapicon
$new_m $path]
1320 if {$new_m eq
{__
}} {
1321 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1323 set file_lists
($old_w) \
1324 [lreplace
$file_lists($old_w) $lno $lno]
1326 $old_w conf
-state normal
1327 $old_w delete
$lno.0 [expr {$lno + 1}].0
1328 $old_w conf
-state disabled
1330 unset file_states
($path)
1331 catch
{unset selected_paths
($path)}
1335 if {$new_w ne
$old_w} {
1336 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1338 set file_lists
($old_w) \
1339 [lreplace
$file_lists($old_w) $lno $lno]
1341 $old_w conf
-state normal
1342 $old_w delete
$lno.0 [expr {$lno + 1}].0
1343 $old_w conf
-state disabled
1346 lappend file_lists
($new_w) $path
1347 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1348 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1350 $new_w conf
-state normal
1351 $new_w image create
$lno.0 \
1352 -align center
-padx 5 -pady 1 \
1353 -name [lindex
$s 1] \
1355 $new_w insert
$lno.1 "[escape_path $path]\n"
1356 if {[catch
{set in_sel
$selected_paths($path)}]} {
1360 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1362 $new_w conf
-state disabled
1363 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1364 $new_w conf
-state normal
1365 $new_w image conf
[lindex
$s 1] -image $new_icon
1366 $new_w conf
-state disabled
1370 proc display_all_files
{} {
1371 global ui_index ui_other
1372 global file_states file_lists
1373 global last_clicked selected_paths
1375 $ui_index conf
-state normal
1376 $ui_other conf
-state normal
1378 $ui_index delete
0.0 end
1379 $ui_other delete
0.0 end
1382 set file_lists
($ui_index) [list
]
1383 set file_lists
($ui_other) [list
]
1385 foreach path
[lsort
[array names file_states
]] {
1386 set s
$file_states($path)
1388 set w
[mapcol
$m $path]
1389 lappend file_lists
($w) $path
1390 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1391 $w image create end \
1392 -align center
-padx 5 -pady 1 \
1393 -name [lindex
$s 1] \
1394 -image [mapicon
$m $path]
1395 $w insert end
"[escape_path $path]\n"
1396 if {[catch
{set in_sel
$selected_paths($path)}]} {
1400 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1404 $ui_index conf
-state disabled
1405 $ui_other conf
-state disabled
1408 proc update_indexinfo
{msg pathList after
} {
1409 global update_index_cp ui_status_value
1411 if {![lock_index update
]} return
1413 set update_index_cp
0
1414 set pathList
[lsort
$pathList]
1415 set totalCnt
[llength
$pathList]
1416 set batch [expr {int
($totalCnt * .01) + 1}]
1417 if {$batch > 25} {set batch 25}
1419 set ui_status_value
[format \
1420 "$msg... %i/%i files (%.2f%%)" \
1424 set fd
[open
"| git update-index -z --index-info" w
]
1430 fileevent
$fd writable
[list \
1431 write_update_indexinfo \
1441 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1442 global update_index_cp ui_status_value
1443 global file_states current_diff
1445 if {$update_index_cp >= $totalCnt} {
1452 for {set i
$batch} \
1453 {$update_index_cp < $totalCnt && $i > 0} \
1455 set path
[lindex
$pathList $update_index_cp]
1456 incr update_index_cp
1458 set s
$file_states($path)
1459 switch
-glob -- [lindex
$s 0] {
1466 set info
[lindex
$s 2]
1467 if {$info eq
{}} continue
1469 puts
-nonewline $fd $info
1470 puts
-nonewline $fd "\t"
1471 puts
-nonewline $fd $path
1472 puts
-nonewline $fd "\0"
1473 display_file
$path $new
1476 set ui_status_value
[format \
1477 "$msg... %i/%i files (%.2f%%)" \
1480 [expr {100.0 * $update_index_cp / $totalCnt}]]
1483 proc update_index
{msg pathList after
} {
1484 global update_index_cp ui_status_value
1486 if {![lock_index update
]} return
1488 set update_index_cp
0
1489 set pathList
[lsort
$pathList]
1490 set totalCnt
[llength
$pathList]
1491 set batch [expr {int
($totalCnt * .01) + 1}]
1492 if {$batch > 25} {set batch 25}
1494 set ui_status_value
[format \
1495 "$msg... %i/%i files (%.2f%%)" \
1499 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1505 fileevent
$fd writable
[list \
1506 write_update_index \
1516 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1517 global update_index_cp ui_status_value
1518 global file_states current_diff
1520 if {$update_index_cp >= $totalCnt} {
1527 for {set i
$batch} \
1528 {$update_index_cp < $totalCnt && $i > 0} \
1530 set path
[lindex
$pathList $update_index_cp]
1531 incr update_index_cp
1533 switch
-glob -- [lindex
$file_states($path) 0] {
1552 puts
-nonewline $fd $path
1553 puts
-nonewline $fd "\0"
1554 display_file
$path $new
1557 set ui_status_value
[format \
1558 "$msg... %i/%i files (%.2f%%)" \
1561 [expr {100.0 * $update_index_cp / $totalCnt}]]
1564 proc checkout_index
{msg pathList after
} {
1565 global update_index_cp ui_status_value
1567 if {![lock_index update
]} return
1569 set update_index_cp
0
1570 set pathList
[lsort
$pathList]
1571 set totalCnt
[llength
$pathList]
1572 set batch [expr {int
($totalCnt * .01) + 1}]
1573 if {$batch > 25} {set batch 25}
1575 set ui_status_value
[format \
1576 "$msg... %i/%i files (%.2f%%)" \
1580 set cmd
[list git checkout-index
]
1586 set fd
[open
"| $cmd " w
]
1592 fileevent
$fd writable
[list \
1593 write_checkout_index \
1603 proc write_checkout_index
{fd pathList totalCnt
batch msg after
} {
1604 global update_index_cp ui_status_value
1605 global file_states current_diff
1607 if {$update_index_cp >= $totalCnt} {
1614 for {set i
$batch} \
1615 {$update_index_cp < $totalCnt && $i > 0} \
1617 set path
[lindex
$pathList $update_index_cp]
1618 incr update_index_cp
1620 switch
-glob -- [lindex
$file_states($path) 0] {
1630 puts
-nonewline $fd $path
1631 puts
-nonewline $fd "\0"
1632 display_file
$path $new
1635 set ui_status_value
[format \
1636 "$msg... %i/%i files (%.2f%%)" \
1639 [expr {100.0 * $update_index_cp / $totalCnt}]]
1642 ######################################################################
1644 ## branch management
1646 proc load_all_heads
{} {
1647 global all_heads tracking_branches
1649 set all_heads
[list
]
1650 set cmd
[list git for-each-ref
]
1651 lappend cmd
--format=%(refname
)
1652 lappend cmd refs
/heads
1653 set fd
[open
"| $cmd" r
]
1654 while {[gets
$fd line
] > 0} {
1655 if {![catch
{set info
$tracking_branches($line)}]} continue
1656 if {![regsub ^refs
/heads
/ $line {} name
]} continue
1657 lappend all_heads
$name
1661 set all_heads
[lsort
$all_heads]
1664 proc populate_branch_menu
{m
} {
1665 global all_heads disable_on_lock
1668 foreach b
$all_heads {
1669 $m add radiobutton \
1671 -command [list switch_branch
$b] \
1672 -variable current_branch \
1675 lappend disable_on_lock \
1676 [list
$m entryconf
[$m index last
] -state]
1680 proc do_create_branch
{} {
1681 error
"NOT IMPLEMENTED"
1684 proc do_delete_branch
{} {
1685 error
"NOT IMPLEMENTED"
1688 proc switch_branch
{b
} {
1689 global HEAD commit_type file_states current_branch
1690 global selected_commit_type ui_comm
1692 if {![lock_index switch
]} return
1694 # -- Backup the selected branch (repository_state resets it)
1696 set new_branch
$current_branch
1698 # -- Our in memory state should match the repository.
1700 repository_state curType curHEAD curMERGE_HEAD
1701 if {[string match amend
* $commit_type]
1702 && $curType eq
{normal
}
1703 && $curHEAD eq
$HEAD} {
1704 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1705 info_popup
{Last scanned state does not match repository state.
1707 Another Git program has modified this repository
1708 since the last scan. A rescan must be performed
1709 before the current branch can be changed.
1711 The rescan will be automatically started now.
1714 rescan
{set ui_status_value
{Ready.
}}
1718 # -- Toss the message buffer if we are in amend mode.
1720 if {[string match amend
* $curType]} {
1721 $ui_comm delete
0.0 end
1723 $ui_comm edit modified false
1726 set selected_commit_type new
1727 set current_branch
$new_branch
1730 error
"NOT FINISHED"
1733 ######################################################################
1735 ## remote management
1737 proc load_all_remotes
{} {
1739 global all_remotes tracking_branches
1741 set all_remotes
[list
]
1742 array
unset tracking_branches
1744 set rm_dir
[gitdir remotes
]
1745 if {[file isdirectory
$rm_dir]} {
1746 set all_remotes
[glob \
1750 -directory $rm_dir *]
1752 foreach name
$all_remotes {
1754 set fd
[open
[file join $rm_dir $name] r
]
1755 while {[gets
$fd line
] >= 0} {
1756 if {![regexp
{^Pull
:[ ]*([^
:]+):(.
+)$
} \
1757 $line line src dst
]} continue
1758 if {![regexp ^refs
/ $dst]} {
1759 set dst
"refs/heads/$dst"
1761 set tracking_branches
($dst) [list
$name $src]
1768 foreach line
[array names repo_config remote.
*.url
] {
1769 if {![regexp ^remote\.
(.
*)\.url\$
$line line name
]} continue
1770 lappend all_remotes
$name
1772 if {[catch
{set fl
$repo_config(remote.
$name.fetch
)}]} {
1776 if {![regexp
{^
([^
:]+):(.
+)$
} $line line src dst
]} continue
1777 if {![regexp ^refs
/ $dst]} {
1778 set dst
"refs/heads/$dst"
1780 set tracking_branches
($dst) [list
$name $src]
1784 set all_remotes
[lsort
-unique $all_remotes]
1787 proc populate_fetch_menu
{m
} {
1788 global all_remotes repo_config
1790 foreach r
$all_remotes {
1792 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1793 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
1798 set fd
[open
[gitdir remotes
$r] r
]
1799 while {[gets
$fd n
] >= 0} {
1800 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
1811 -label "Fetch from $r..." \
1812 -command [list fetch_from
$r] \
1818 proc populate_push_menu
{m
} {
1819 global all_remotes repo_config
1821 foreach r
$all_remotes {
1823 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1824 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
1829 set fd
[open
[gitdir remotes
$r] r
]
1830 while {[gets
$fd n
] >= 0} {
1831 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
1842 -label "Push to $r..." \
1843 -command [list push_to
$r] \
1849 proc populate_pull_menu
{m
} {
1850 global repo_config all_remotes disable_on_lock
1852 foreach remote
$all_remotes {
1854 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1855 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1856 foreach line
$repo_config(remote.
$remote.fetch
) {
1857 if {[regexp
{^
([^
:]+):} $line line rb
]} {
1864 set fd
[open
[gitdir remotes
$remote] r
]
1865 while {[gets
$fd line
] >= 0} {
1866 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1874 foreach rb
$rb_list {
1875 regsub ^refs
/heads
/ $rb {} rb_short
1877 -label "Branch $rb_short from $remote..." \
1878 -command [list pull_remote
$remote $rb] \
1880 lappend disable_on_lock \
1881 [list
$m entryconf
[$m index last
] -state]
1886 ######################################################################
1891 #define mask_width 14
1892 #define mask_height 15
1893 static unsigned char mask_bits
[] = {
1894 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1895 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1896 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1899 image create bitmap file_plain
-background white
-foreground black
-data {
1900 #define plain_width 14
1901 #define plain_height 15
1902 static unsigned char plain_bits
[] = {
1903 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1904 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1905 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1906 } -maskdata $filemask
1908 image create bitmap file_mod
-background white
-foreground blue
-data {
1909 #define mod_width 14
1910 #define mod_height 15
1911 static unsigned char mod_bits
[] = {
1912 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1913 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1914 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1915 } -maskdata $filemask
1917 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1918 #define file_fulltick_width 14
1919 #define file_fulltick_height 15
1920 static unsigned char file_fulltick_bits
[] = {
1921 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1922 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1923 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1924 } -maskdata $filemask
1926 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1927 #define parttick_width 14
1928 #define parttick_height 15
1929 static unsigned char parttick_bits
[] = {
1930 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1931 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1932 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1933 } -maskdata $filemask
1935 image create bitmap file_question
-background white
-foreground black
-data {
1936 #define file_question_width 14
1937 #define file_question_height 15
1938 static unsigned char file_question_bits
[] = {
1939 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1940 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1941 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1942 } -maskdata $filemask
1944 image create bitmap file_removed
-background white
-foreground red
-data {
1945 #define file_removed_width 14
1946 #define file_removed_height 15
1947 static unsigned char file_removed_bits
[] = {
1948 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1949 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1950 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1951 } -maskdata $filemask
1953 image create bitmap file_merge
-background white
-foreground blue
-data {
1954 #define file_merge_width 14
1955 #define file_merge_height 15
1956 static unsigned char file_merge_bits
[] = {
1957 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1958 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1959 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1960 } -maskdata $filemask
1962 set ui_index .vpane.files.index.list
1963 set ui_other .vpane.files.other.list
1964 set max_status_desc
0
1966 {__ i plain
"Unmodified"}
1967 {_M i mod
"Modified"}
1968 {M_ i fulltick
"Added to commit"}
1969 {MM i parttick
"Partially included"}
1970 {MD i question
"Added (but gone)"}
1972 {_O o plain
"Untracked"}
1973 {A_ o fulltick
"Added by commit"}
1974 {AM o parttick
"Partially added"}
1975 {AD o question
"Added (but gone)"}
1977 {_D i question
"Missing"}
1978 {DD i removed
"Removed by commit"}
1979 {D_ i removed
"Removed by commit"}
1980 {DO i removed
"Removed (still exists)"}
1981 {DM i removed
"Removed (but modified)"}
1983 {UD i merge
"Merge conflicts"}
1984 {UM i merge
"Merge conflicts"}
1985 {U_ i merge
"Merge conflicts"}
1987 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1988 set max_status_desc
[string length
[lindex
$i 3]]
1990 if {[lindex
$i 1] eq
{i
}} {
1991 set all_cols
([lindex
$i 0]) $ui_index
1993 set all_cols
([lindex
$i 0]) $ui_other
1995 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1996 set all_descs
([lindex
$i 0]) [lindex
$i 3]
2000 ######################################################################
2005 global tcl_platform tk_library
2006 if {[tk windowingsystem
] eq
{aqua
}} {
2012 proc is_Windows
{} {
2014 if {$tcl_platform(platform
) eq
{windows
}} {
2020 proc bind_button3
{w cmd
} {
2021 bind $w <Any-Button-3
> $cmd
2023 bind $w <Control-Button-1
> $cmd
2027 proc incr_font_size
{font
{amt
1}} {
2028 set sz
[font configure
$font -size]
2030 font configure
$font -size $sz
2031 font configure
${font}bold
-size $sz
2034 proc hook_failed_popup
{hook msg
} {
2039 label
$w.m.l1
-text "$hook hook failed:" \
2044 -background white
-borderwidth 1 \
2046 -width 80 -height 10 \
2048 -yscrollcommand [list
$w.m.sby
set]
2050 -text {You must correct the above errors before committing.
} \
2054 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2055 pack
$w.m.l1
-side top
-fill x
2056 pack
$w.m.l2
-side bottom
-fill x
2057 pack
$w.m.sby
-side right
-fill y
2058 pack
$w.m.t
-side left
-fill both
-expand 1
2059 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2061 $w.m.t insert
1.0 $msg
2062 $w.m.t conf
-state disabled
2064 button
$w.ok
-text OK \
2067 -command "destroy $w"
2068 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2070 bind $w <Visibility
> "grab $w; focus $w"
2071 bind $w <Key-Return
> "destroy $w"
2072 wm title
$w "[appname] ([reponame]): error"
2076 set next_console_id
0
2078 proc new_console
{short_title long_title
} {
2079 global next_console_id console_data
2080 set w .console
[incr next_console_id
]
2081 set console_data
($w) [list
$short_title $long_title]
2082 return [console_init
$w]
2085 proc console_init
{w
} {
2086 global console_cr console_data M1B
2088 set console_cr
($w) 1.0
2091 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
2096 -background white
-borderwidth 1 \
2098 -width 80 -height 10 \
2101 -yscrollcommand [list
$w.m.sby
set]
2102 label
$w.m.s
-text {Working... please
wait...
} \
2106 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
2107 pack
$w.m.l1
-side top
-fill x
2108 pack
$w.m.s
-side bottom
-fill x
2109 pack
$w.m.sby
-side right
-fill y
2110 pack
$w.m.t
-side left
-fill both
-expand 1
2111 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
2113 menu
$w.ctxm
-tearoff 0
2114 $w.ctxm add
command -label "Copy" \
2116 -command "tk_textCopy $w.m.t"
2117 $w.ctxm add
command -label "Select All" \
2119 -command "$w.m.t tag add sel 0.0 end"
2120 $w.ctxm add
command -label "Copy All" \
2123 $w.m.t tag add sel 0.0 end
2125 $w.m.t tag remove sel 0.0 end
2128 button
$w.ok
-text {Close
} \
2131 -command "destroy $w"
2132 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
2134 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
2135 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
2136 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
2137 bind $w <Visibility
> "focus $w"
2138 wm title
$w "[appname] ([reponame]): [lindex $console_data($w) 0]"
2142 proc console_exec
{w cmd
{after
{}}} {
2143 # -- Windows tosses the enviroment when we exec our child.
2144 # But most users need that so we have to relogin. :-(
2147 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
2150 # -- Tcl won't let us redirect both stdout and stderr to
2151 # the same pipe. So pass it through cat...
2153 set cmd
[concat |
$cmd |
& cat]
2155 set fd_f
[open
$cmd r
]
2156 fconfigure
$fd_f -blocking 0 -translation binary
2157 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
2160 proc console_read
{w fd after
} {
2161 global console_cr console_data
2165 if {![winfo exists
$w]} {console_init
$w}
2166 $w.m.t conf
-state normal
2168 set n
[string length
$buf]
2170 set cr
[string first
"\r" $buf $c]
2171 set lf
[string first
"\n" $buf $c]
2172 if {$cr < 0} {set cr
[expr {$n + 1}]}
2173 if {$lf < 0} {set lf
[expr {$n + 1}]}
2176 $w.m.t insert end
[string range
$buf $c $lf]
2177 set console_cr
($w) [$w.m.t index
{end
-1c}]
2181 $w.m.t delete
$console_cr($w) end
2182 $w.m.t insert end
"\n"
2183 $w.m.t insert end
[string range
$buf $c $cr]
2188 $w.m.t conf
-state disabled
2192 fconfigure
$fd -blocking 1
2194 if {[catch
{close
$fd}]} {
2195 if {![winfo exists
$w]} {console_init
$w}
2196 $w.m.s conf
-background red
-text {Error
: Command Failed
}
2197 $w.ok conf
-state normal
2199 } elseif
{[winfo exists
$w]} {
2200 $w.m.s conf
-background green
-text {Success
}
2201 $w.ok conf
-state normal
2204 array
unset console_cr
$w
2205 array
unset console_data
$w
2207 uplevel
#0 $after $ok
2211 fconfigure
$fd -blocking 0
2214 ######################################################################
2218 set starting_gitk_msg
{Starting gitk... please
wait...
}
2220 proc do_gitk
{revs
} {
2221 global ui_status_value starting_gitk_msg
2229 set cmd
"sh -c \"exec $cmd\""
2233 if {[catch
{eval exec $cmd} err
]} {
2234 error_popup
"Failed to start gitk:\n\n$err"
2236 set ui_status_value
$starting_gitk_msg
2238 if {$ui_status_value eq
$starting_gitk_msg} {
2239 set ui_status_value
{Ready.
}
2246 set w
[new_console
{gc
} {Compressing the object database
}]
2247 console_exec
$w {git gc
}
2250 proc do_fsck_objects
{} {
2251 set w
[new_console
{fsck-objects
} \
2252 {Verifying the object database with fsck-objects
}]
2253 set cmd
[list git fsck-objects
]
2256 lappend cmd
--strict
2257 console_exec
$w $cmd
2263 global ui_comm is_quitting repo_config commit_type
2265 if {$is_quitting} return
2268 # -- Stash our current commit buffer.
2270 set save
[gitdir GITGUI_MSG
]
2271 set msg
[string trim
[$ui_comm get
0.0 end
]]
2272 if {![string match amend
* $commit_type]
2273 && [$ui_comm edit modified
]
2276 set fd
[open
$save w
]
2277 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
2281 catch
{file delete
$save}
2284 # -- Stash our current window geometry into this repository.
2286 set cfg_geometry
[list
]
2287 lappend cfg_geometry
[wm geometry .
]
2288 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
2289 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
2290 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2293 if {$cfg_geometry ne
$rc_geometry} {
2294 catch
{exec git repo-config gui.geometry
$cfg_geometry}
2301 rescan
{set ui_status_value
{Ready.
}}
2304 proc remove_helper
{txt paths
} {
2305 global file_states current_diff
2307 if {![lock_index begin-update
]} return
2311 foreach path
$paths {
2312 switch
-glob -- [lindex
$file_states($path) 0] {
2316 lappend pathList
$path
2317 if {$path eq
$current_diff} {
2318 set after
{reshow_diff
;}
2323 if {$pathList eq
{}} {
2329 [concat
$after {set ui_status_value
{Ready.
}}]
2333 proc do_remove_selection
{} {
2334 global current_diff selected_paths
2336 if {[array size selected_paths
] > 0} {
2338 {Removing selected files from commit
} \
2339 [array names selected_paths
]
2340 } elseif
{$current_diff ne
{}} {
2342 "Removing [short_path $current_diff] from commit" \
2343 [list
$current_diff]
2347 proc include_helper
{txt paths
} {
2348 global file_states current_diff
2350 if {![lock_index begin-update
]} return
2354 foreach path
$paths {
2355 switch
-glob -- [lindex
$file_states($path) 0] {
2364 lappend pathList
$path
2365 if {$path eq
$current_diff} {
2366 set after
{reshow_diff
;}
2371 if {$pathList eq
{}} {
2377 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2381 proc do_include_selection
{} {
2382 global current_diff selected_paths
2384 if {[array size selected_paths
] > 0} {
2386 {Adding selected files
} \
2387 [array names selected_paths
]
2388 } elseif
{$current_diff ne
{}} {
2390 "Adding [short_path $current_diff]" \
2391 [list
$current_diff]
2395 proc do_include_all
{} {
2399 foreach path
[array names file_states
] {
2400 switch
-- [lindex
$file_states($path) 0] {
2406 _D
{lappend paths
$path}
2410 {Adding all modified files
} \
2414 proc revert_helper
{txt paths
} {
2415 global file_states current_diff
2417 if {![lock_index begin-update
]} return
2421 foreach path
$paths {
2422 switch
-glob -- [lindex
$file_states($path) 0] {
2429 lappend pathList
$path
2430 if {$path eq
$current_diff} {
2431 set after
{reshow_diff
;}
2437 set n
[llength
$pathList]
2441 } elseif
{$n == 1} {
2442 set s
"[short_path [lindex $pathList]]"
2444 set s
"these $n files"
2447 set reply
[tk_dialog \
2449 "[appname] ([reponame])" \
2450 "Revert changes in $s?
2452 Any unadded changes will be permanently lost by the revert." \
2462 [concat
$after {set ui_status_value
{Ready.
}}]
2468 proc do_revert_selection
{} {
2469 global current_diff selected_paths
2471 if {[array size selected_paths
] > 0} {
2473 {Reverting selected files
} \
2474 [array names selected_paths
]
2475 } elseif
{$current_diff ne
{}} {
2477 "Reverting [short_path $current_diff]" \
2478 [list
$current_diff]
2482 proc do_signoff
{} {
2485 set me
[committer_ident
]
2486 if {$me eq
{}} return
2488 set sob
"Signed-off-by: $me"
2489 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2490 if {$last ne
$sob} {
2491 $ui_comm edit separator
2493 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2494 $ui_comm insert end
"\n"
2496 $ui_comm insert end
"\n$sob"
2497 $ui_comm edit separator
2502 proc do_select_commit_type
{} {
2503 global commit_type selected_commit_type
2505 if {$selected_commit_type eq
{new
}
2506 && [string match amend
* $commit_type]} {
2508 } elseif
{$selected_commit_type eq
{amend
}
2509 && ![string match amend
* $commit_type]} {
2512 # The amend request was rejected...
2514 if {![string match amend
* $commit_type]} {
2515 set selected_commit_type new
2525 global appvers copyright
2526 global tcl_patchLevel tk_patchLevel
2530 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2532 label
$w.header
-text "About [appname]" \
2534 pack
$w.header
-side top
-fill x
2537 button
$w.buttons.close
-text {Close
} \
2539 -command [list destroy
$w]
2540 pack
$w.buttons.close
-side right
2541 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2544 -text "[appname] - a commit creation tool for Git.
2552 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
2555 append v
"[appname] version $appvers\n"
2556 append v
"[exec git version]\n"
2558 if {$tcl_patchLevel eq
$tk_patchLevel} {
2559 append v
"Tcl/Tk version $tcl_patchLevel"
2561 append v
"Tcl version $tcl_patchLevel"
2562 append v
", Tk version $tk_patchLevel"
2573 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
2575 menu
$w.ctxm
-tearoff 0
2576 $w.ctxm add
command \
2581 clipboard append -format STRING -type STRING -- \[$w.vers cget -text\]
2584 bind $w <Visibility
> "grab $w; focus $w"
2585 bind $w <Key-Escape
> "destroy $w"
2586 bind_button3
$w.vers
"tk_popup $w.ctxm %X %Y; grab $w; focus $w"
2587 wm title
$w "About [appname]"
2591 proc do_options
{} {
2592 global repo_config global_config font_descs
2593 global repo_config_new global_config_new
2595 array
unset repo_config_new
2596 array
unset global_config_new
2597 foreach name
[array names repo_config
] {
2598 set repo_config_new
($name) $repo_config($name)
2601 foreach name
[array names repo_config
] {
2603 gui.diffcontext
{continue}
2605 set repo_config_new
($name) $repo_config($name)
2607 foreach name
[array names global_config
] {
2608 set global_config_new
($name) $global_config($name)
2611 set w .options_editor
2613 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2615 label
$w.header
-text "[appname] Options" \
2617 pack
$w.header
-side top
-fill x
2620 button
$w.buttons.restore
-text {Restore Defaults
} \
2622 -command do_restore_defaults
2623 pack
$w.buttons.restore
-side left
2624 button
$w.buttons.save
-text Save \
2626 -command [list do_save_config
$w]
2627 pack
$w.buttons.save
-side right
2628 button
$w.buttons.cancel
-text {Cancel
} \
2630 -command [list destroy
$w]
2631 pack
$w.buttons.cancel
-side right
2632 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2634 labelframe
$w.repo
-text "[reponame] Repository" \
2636 -relief raised
-borderwidth 2
2637 labelframe
$w.global
-text {Global
(All Repositories
)} \
2639 -relief raised
-borderwidth 2
2640 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
2641 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
2644 {b partialinclude
{Allow Partially Added Files
}}
2645 {b pullsummary
{Show Pull Summary
}}
2646 {b trustmtime
{Trust File Modification Timestamps
}}
2647 {i diffcontext
{Number of Diff Context Lines
}}
2649 set type [lindex
$option 0]
2650 set name
[lindex
$option 1]
2651 set text
[lindex
$option 2]
2652 foreach f
{repo global
} {
2655 checkbutton
$w.
$f.
$name -text $text \
2656 -variable ${f}_config_new
(gui.
$name) \
2660 pack
$w.
$f.
$name -side top
-anchor w
2664 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
2665 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
2666 spinbox
$w.
$f.
$name.v \
2667 -textvariable ${f}_config_new
(gui.
$name) \
2668 -from 1 -to 99 -increment 1 \
2671 pack
$w.
$f.
$name.v
-side right
-anchor e
2672 pack
$w.
$f.
$name -side top
-anchor w
-fill x
2678 set all_fonts
[lsort
[font families
]]
2679 foreach option
$font_descs {
2680 set name
[lindex
$option 0]
2681 set font
[lindex
$option 1]
2682 set text
[lindex
$option 2]
2684 set global_config_new
(gui.
$font^^family
) \
2685 [font configure
$font -family]
2686 set global_config_new
(gui.
$font^^size
) \
2687 [font configure
$font -size]
2689 frame
$w.global.
$name
2690 label
$w.global.
$name.l
-text "$text:" -font font_ui
2691 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
2692 eval tk_optionMenu
$w.global.
$name.family \
2693 global_config_new
(gui.
$font^^family
) \
2695 spinbox
$w.global.
$name.size \
2696 -textvariable global_config_new
(gui.
$font^^size
) \
2697 -from 2 -to 80 -increment 1 \
2700 pack
$w.global.
$name.size
-side right
-anchor e
2701 pack
$w.global.
$name.family
-side right
-anchor e
2702 pack
$w.global.
$name -side top
-anchor w
-fill x
2705 bind $w <Visibility
> "grab $w; focus $w"
2706 bind $w <Key-Escape
> "destroy $w"
2707 wm title
$w "[appname] ([reponame]): Options"
2711 proc do_restore_defaults
{} {
2712 global font_descs default_config repo_config
2713 global repo_config_new global_config_new
2715 foreach name
[array names default_config
] {
2716 set repo_config_new
($name) $default_config($name)
2717 set global_config_new
($name) $default_config($name)
2720 foreach option
$font_descs {
2721 set name
[lindex
$option 0]
2722 set repo_config
(gui.
$name) $default_config(gui.
$name)
2726 foreach option
$font_descs {
2727 set name
[lindex
$option 0]
2728 set font
[lindex
$option 1]
2729 set global_config_new
(gui.
$font^^family
) \
2730 [font configure
$font -family]
2731 set global_config_new
(gui.
$font^^size
) \
2732 [font configure
$font -size]
2736 proc do_save_config
{w
} {
2737 if {[catch
{save_config
} err
]} {
2738 error_popup
"Failed to completely save options:\n\n$err"
2744 proc do_windows_shortcut
{} {
2748 set desktop
[exec cygpath \
2756 set fn
[tk_getSaveFile \
2758 -title "[appname] ([reponame]): Create Desktop Icon" \
2759 -initialdir $desktop \
2760 -initialfile "Git [reponame].bat"]
2764 set sh
[exec cygpath \
2768 set me
[exec cygpath \
2772 set gd
[exec cygpath \
2776 regsub
-all ' $me "'\\''" me
2777 regsub -all ' $gd "'\\''" gd
2778 puts $fd "@ECHO Starting git-gui... Please wait..."
2779 puts -nonewline $fd "@\"$sh\" --login -c \""
2780 puts -nonewline $fd "GIT_DIR='$gd'"
2781 puts -nonewline $fd " '$me'"
2785 error_popup "Cannot write script:\n\n$err"
2790 proc do_macosx_app {} {
2793 set fn [tk_getSaveFile \
2795 -title "[appname] ([reponame]): Create Desktop Icon" \
2796 -initialdir [file join $env(HOME) Desktop] \
2797 -initialfile "Git [reponame].app"]
2800 set Contents [file join $fn Contents]
2801 set MacOS [file join $Contents MacOS]
2802 set exe [file join $MacOS git-gui]
2806 set fd [open [file join $Contents Info.plist] w]
2807 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2808 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2809 <plist version="1.0">
2811 <key>CFBundleDevelopmentRegion</key>
2812 <string>English</string>
2813 <key>CFBundleExecutable</key>
2814 <string>git-gui</string>
2815 <key>CFBundleIdentifier</key>
2816 <string>org.spearce.git-gui</string>
2817 <key>CFBundleInfoDictionaryVersion</key>
2818 <string>6.0</string>
2819 <key>CFBundlePackageType</key>
2820 <string>APPL</string>
2821 <key>CFBundleSignature</key>
2822 <string>????</string>
2823 <key>CFBundleVersion</key>
2824 <string>1.0</string>
2825 <key>NSPrincipalClass</key>
2826 <string>NSApplication</string>
2831 set fd [open $exe w]
2832 set gd [file normalize [gitdir]]
2833 set ep [file normalize [exec git --exec-path]]
2834 regsub -all ' $gd "'\\''" gd
2835 regsub
-all ' $ep "'\\''" ep
2836 puts $fd "#!/bin/sh"
2837 foreach name
[array names env
] {
2838 if {[string match GIT_
* $name]} {
2839 regsub
-all ' $env($name) "'\\''" v
2840 puts $fd "export $name='$v'"
2843 puts $fd "export PATH
='$ep':\
$PATH"
2844 puts $fd "export GIT_DIR
='$gd'"
2845 puts $fd "exec [file normalize
$argv0]"
2848 file attributes $exe -permissions u+x,g+x,o+x
2850 error_popup "Cannot
write icon
:\n\n$err"
2855 proc toggle_or_diff {w x y} {
2856 global file_states file_lists current_diff ui_index ui_other
2857 global last_clicked selected_paths
2859 set pos [split [$w index @$x,$y] .]
2860 set lno [lindex $pos 0]
2861 set col [lindex $pos 1]
2862 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2868 set last_clicked [list $w $lno]
2869 array unset selected_paths
2870 $ui_index tag remove in_sel 0.0 end
2871 $ui_other tag remove in_sel 0.0 end
2874 if {$current_diff eq $path} {
2875 set after {reshow_diff;}
2879 switch -glob -- [lindex $file_states($path) 0] {
2886 "Removing
[short_path
$path] from commit
" \
2888 [concat $after {set ui_status_value {Ready.}}]
2892 "Adding
[short_path
$path]" \
2894 [concat $after {set ui_status_value {Ready.}}]
2898 show_diff $path $w $lno
2902 proc add_one_to_selection {w x y} {
2904 global last_clicked selected_paths
2906 set pos [split [$w index @$x,$y] .]
2907 set lno [lindex $pos 0]
2908 set col [lindex $pos 1]
2909 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2915 set last_clicked [list $w $lno]
2916 if {[catch {set in_sel $selected_paths($path)}]} {
2920 unset selected_paths($path)
2921 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2923 set selected_paths($path) 1
2924 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2928 proc add_range_to_selection {w x y} {
2930 global last_clicked selected_paths
2932 if {[lindex $last_clicked 0] ne $w} {
2933 toggle_or_diff $w $x $y
2937 set pos [split [$w index @$x,$y] .]
2938 set lno [lindex $pos 0]
2939 set lc [lindex $last_clicked 1]
2948 foreach path [lrange $file_lists($w) \
2949 [expr {$begin - 1}] \
2950 [expr {$end - 1}]] {
2951 set selected_paths($path) 1
2953 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2956 ######################################################################
2960 set cursor_ptr arrow
2961 font create font_diff -family Courier -size 10
2965 eval font configure font_ui [font actual [.dummy cget -font]]
2969 font create font_uibold
2970 font create font_diffbold
2975 } elseif {[is_MacOSX]} {
2983 proc apply_config {} {
2984 global repo_config font_descs
2986 foreach option $font_descs {
2987 set name [lindex $option 0]
2988 set font [lindex $option 1]
2990 foreach {cn cv} $repo_config(gui.$name) {
2991 font configure $font $cn $cv
2994 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
2996 foreach {cn cv} [font configure $font] {
2997 font configure ${font}bold $cn $cv
2999 font configure ${font}bold -weight bold
3003 set default_config(gui.trustmtime) false
3004 set default_config(gui.pullsummary) true
3005 set default_config(gui.partialinclude) false
3006 set default_config(gui.diffcontext) 5
3007 set default_config(gui.fontui) [font configure font_ui]
3008 set default_config(gui.fontdiff) [font configure font_diff]
3010 {fontui font_ui {Main Font}}
3011 {fontdiff font_diff {Diff/Console Font}}
3016 ######################################################################
3022 menu .mbar -tearoff 0
3023 .mbar add cascade -label Repository -menu .mbar.repository
3024 .mbar add cascade -label Edit -menu .mbar.edit
3025 if {!$single_commit} {
3026 .mbar add cascade -label Branch -menu .mbar.branch
3028 .mbar add cascade -label Commit -menu .mbar.commit
3029 if {!$single_commit} {
3030 .mbar add cascade -label Fetch -menu .mbar.fetch
3031 .mbar add cascade -label Pull -menu .mbar.pull
3032 .mbar add cascade -label Push -menu .mbar.push
3034 . configure -menu .mbar
3036 # -- Repository Menu
3038 menu .mbar.repository
3039 .mbar.repository add command \
3040 -label {Visualize Current Branch} \
3041 -command {do_gitk {}} \
3044 .mbar.repository add command \
3045 -label {Visualize All Branches} \
3046 -command {do_gitk {--all}} \
3049 .mbar.repository add separator
3051 if {!$single_commit} {
3052 .mbar.repository add command -label {Compress Database} \
3056 .mbar.repository add command -label {Verify Database} \
3057 -command do_fsck_objects \
3060 .mbar.repository add separator
3063 .mbar.repository add command \
3064 -label {Create Desktop Icon} \
3065 -command do_windows_shortcut \
3067 } elseif {[is_MacOSX]} {
3068 .mbar.repository add command \
3069 -label {Create Desktop Icon} \
3070 -command do_macosx_app \
3075 .mbar.repository add command -label Quit \
3077 -accelerator $M1T-Q \
3083 .mbar.edit add command -label Undo \
3084 -command {catch {[focus] edit undo}} \
3085 -accelerator $M1T-Z \
3087 .mbar.edit add command -label Redo \
3088 -command {catch {[focus] edit redo}} \
3089 -accelerator $M1T-Y \
3091 .mbar.edit add separator
3092 .mbar.edit add command -label Cut \
3093 -command {catch {tk_textCut [focus]}} \
3094 -accelerator $M1T-X \
3096 .mbar.edit add command -label Copy \
3097 -command {catch {tk_textCopy [focus]}} \
3098 -accelerator $M1T-C \
3100 .mbar.edit add command -label Paste \
3101 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
3102 -accelerator $M1T-V \
3104 .mbar.edit add command -label Delete \
3105 -command {catch {[focus] delete sel.first sel.last}} \
3108 .mbar.edit add separator
3109 .mbar.edit add command -label {Select All} \
3110 -command {catch {[focus] tag add sel 0.0 end}} \
3111 -accelerator $M1T-A \
3116 if {!$single_commit} {
3119 .mbar.branch add command -label {Create...} \
3120 -command do_create_branch \
3122 lappend disable_on_lock [list .mbar.branch entryconf \
3123 [.mbar.branch index last] -state]
3125 .mbar.branch add command -label {Delete...} \
3126 -command do_delete_branch \
3128 lappend disable_on_lock [list .mbar.branch entryconf \
3129 [.mbar.branch index last] -state]
3136 .mbar.commit add radiobutton \
3137 -label {New Commit} \
3138 -command do_select_commit_type \
3139 -variable selected_commit_type \
3142 lappend disable_on_lock \
3143 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3145 .mbar.commit add radiobutton \
3146 -label {Amend Last Commit} \
3147 -command do_select_commit_type \
3148 -variable selected_commit_type \
3151 lappend disable_on_lock \
3152 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3154 .mbar.commit add separator
3156 .mbar.commit add command -label Rescan \
3157 -command do_rescan \
3160 lappend disable_on_lock \
3161 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3163 .mbar.commit add command -label {Add To Commit} \
3164 -command do_include_selection \
3166 lappend disable_on_lock \
3167 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3169 .mbar.commit add command -label {Add All To Commit} \
3170 -command do_include_all \
3171 -accelerator $M1T-I \
3173 lappend disable_on_lock \
3174 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3176 .mbar.commit add command -label {Remove From Commit} \
3177 -command do_remove_selection \
3179 lappend disable_on_lock \
3180 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3182 .mbar.commit add command -label {Revert Changes} \
3183 -command do_revert_selection \
3185 lappend disable_on_lock \
3186 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3188 .mbar.commit add separator
3190 .mbar.commit add command -label {Sign Off} \
3191 -command do_signoff \
3192 -accelerator $M1T-S \
3195 .mbar.commit add command -label Commit \
3196 -command do_commit \
3197 -accelerator $M1T-Return \
3199 lappend disable_on_lock \
3200 [list .mbar.commit entryconf [.mbar.commit index last] -state]
3202 # -- Transport menus
3204 if {!$single_commit} {
3211 # -- Apple Menu (Mac OS X only)
3213 .mbar add cascade -label Apple -menu .mbar.apple
3216 .mbar.apple add command -label "About
[appname
]" \
3219 .mbar.apple add command -label "[appname
] Options...
" \
3220 -command do_options \
3225 .mbar.edit add separator
3226 .mbar.edit add command -label {Options...} \
3227 -command do_options \
3232 if {[file exists /usr/local/miga/lib/gui-miga]
3233 && [file exists .pvcsrc]} {
3235 global ui_status_value
3236 if {![lock_index update]} return
3237 set cmd [list sh --login -c "/usr
/local
/miga
/lib
/gui-miga
\"[pwd]\""]
3238 set miga_fd [open "|
$cmd" r]
3239 fconfigure $miga_fd -blocking 0
3240 fileevent $miga_fd readable [list miga_done $miga_fd]
3241 set ui_status_value {Running miga...}
3243 proc miga_done {fd} {
3248 rescan [list set ui_status_value {Ready.}]
3251 .mbar add cascade -label Tools -menu .mbar.tools
3253 .mbar.tools add command -label "Migrate
" \
3256 lappend disable_on_lock \
3257 [list .mbar.tools entryconf [.mbar.tools index last] -state]
3262 .mbar add cascade -label Help -menu .mbar.help
3265 .mbar.help add command -label "About
[appname
]" \
3277 -text {Current Branch:} \
3282 -textvariable current_branch \
3286 pack .branch.l1 -side left
3287 pack .branch.cb -side left -fill x
3288 pack .branch -side top -fill x
3290 # -- Main Window Layout
3292 panedwindow .vpane -orient vertical
3293 panedwindow .vpane.files -orient horizontal
3294 .vpane add .vpane.files -sticky nsew -height 100 -width 400
3295 pack .vpane -anchor n -side top -fill both -expand 1
3297 # -- Index File List
3299 frame .vpane.files.index -height 100 -width 400
3300 label .vpane.files.index.title -text {Modified Files} \
3303 text $ui_index -background white -borderwidth 0 \
3304 -width 40 -height 10 \
3306 -cursor $cursor_ptr \
3307 -yscrollcommand {.vpane.files.index.sb set} \
3309 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
3310 pack .vpane.files.index.title -side top -fill x
3311 pack .vpane.files.index.sb -side right -fill y
3312 pack $ui_index -side left -fill both -expand 1
3313 .vpane.files add .vpane.files.index -sticky nsew
3315 # -- Other (Add) File List
3317 frame .vpane.files.other -height 100 -width 100
3318 label .vpane.files.other.title -text {Untracked Files} \
3321 text $ui_other -background white -borderwidth 0 \
3322 -width 40 -height 10 \
3324 -cursor $cursor_ptr \
3325 -yscrollcommand {.vpane.files.other.sb set} \
3327 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
3328 pack .vpane.files.other.title -side top -fill x
3329 pack .vpane.files.other.sb -side right -fill y
3330 pack $ui_other -side left -fill both -expand 1
3331 .vpane.files add .vpane.files.other -sticky nsew
3333 foreach i [list $ui_index $ui_other] {
3334 $i tag conf in_diff -font font_uibold
3335 $i tag conf in_sel \
3336 -background [$i cget -foreground] \
3337 -foreground [$i cget -background]
3341 # -- Diff and Commit Area
3343 frame .vpane.lower -height 300 -width 400
3344 frame .vpane.lower.commarea
3345 frame .vpane.lower.diff -relief sunken -borderwidth 1
3346 pack .vpane.lower.commarea -side top -fill x
3347 pack .vpane.lower.diff -side bottom -fill both -expand 1
3348 .vpane add .vpane.lower -stick nsew
3350 # -- Commit Area Buttons
3352 frame .vpane.lower.commarea.buttons
3353 label .vpane.lower.commarea.buttons.l -text {} \
3357 pack .vpane.lower.commarea.buttons.l -side top -fill x
3358 pack .vpane.lower.commarea.buttons -side left -fill y
3360 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
3361 -command do_rescan \
3363 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
3364 lappend disable_on_lock \
3365 {.vpane.lower.commarea.buttons.rescan conf -state}
3367 button .vpane.lower.commarea.buttons.incall -text {Add All} \
3368 -command do_include_all \
3370 pack .vpane.lower.commarea.buttons.incall -side top -fill x
3371 lappend disable_on_lock \
3372 {.vpane.lower.commarea.buttons.incall conf -state}
3374 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
3375 -command do_signoff \
3377 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
3379 button .vpane.lower.commarea.buttons.commit -text {Commit} \
3380 -command do_commit \
3382 pack .vpane.lower.commarea.buttons.commit -side top -fill x
3383 lappend disable_on_lock \
3384 {.vpane.lower.commarea.buttons.commit conf -state}
3386 # -- Commit Message Buffer
3388 frame .vpane.lower.commarea.buffer
3389 frame .vpane.lower.commarea.buffer.header
3390 set ui_comm .vpane.lower.commarea.buffer.t
3391 set ui_coml .vpane.lower.commarea.buffer.header.l
3392 radiobutton .vpane.lower.commarea.buffer.header.new \
3393 -text {New Commit} \
3394 -command do_select_commit_type \
3395 -variable selected_commit_type \
3398 lappend disable_on_lock \
3399 [list .vpane.lower.commarea.buffer.header.new conf -state]
3400 radiobutton .vpane.lower.commarea.buffer.header.amend \
3401 -text {Amend Last Commit} \
3402 -command do_select_commit_type \
3403 -variable selected_commit_type \
3406 lappend disable_on_lock \
3407 [list .vpane.lower.commarea.buffer.header.amend conf -state]
3412 proc trace_commit_type {varname args} {
3413 global ui_coml commit_type
3414 switch -glob -- $commit_type {
3415 initial {set txt {Initial Commit Message:}}
3416 amend {set txt {Amended Commit Message:}}
3417 amend-initial {set txt {Amended Initial Commit Message:}}
3418 amend-merge {set txt {Amended Merge Commit Message:}}
3419 merge {set txt {Merge Commit Message:}}
3420 * {set txt {Commit Message:}}
3422 $ui_coml conf -text $txt
3424 trace add variable commit_type write trace_commit_type
3425 pack $ui_coml -side left -fill x
3426 pack .vpane.lower.commarea.buffer.header.amend -side right
3427 pack .vpane.lower.commarea.buffer.header.new -side right
3429 text $ui_comm -background white -borderwidth 1 \
3432 -autoseparators true \
3434 -width 75 -height 9 -wrap none \
3436 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
3437 scrollbar .vpane.lower.commarea.buffer.sby \
3438 -command [list $ui_comm yview]
3439 pack .vpane.lower.commarea.buffer.header -side top -fill x
3440 pack .vpane.lower.commarea.buffer.sby -side right -fill y
3441 pack $ui_comm -side left -fill y
3442 pack .vpane.lower.commarea.buffer -side left -fill y
3444 # -- Commit Message Buffer Context Menu
3446 set ctxm .vpane.lower.commarea.buffer.ctxm
3447 menu $ctxm -tearoff 0
3451 -command {tk_textCut $ui_comm}
3455 -command {tk_textCopy $ui_comm}
3459 -command {tk_textPaste $ui_comm}
3463 -command {$ui_comm delete sel.first sel.last}
3466 -label {Select All} \
3468 -command {$ui_comm tag add sel 0.0 end}
3473 $ui_comm tag add sel 0.0 end
3474 tk_textCopy $ui_comm
3475 $ui_comm tag remove sel 0.0 end
3482 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
3487 set diff_actions [list]
3488 proc trace_current_diff {varname args} {
3489 global current_diff diff_actions file_states
3490 if {$current_diff eq {}} {
3497 set s [mapdesc [lindex $file_states($p) 0] $p]
3499 set p [escape_path $p]
3503 .vpane.lower.diff.header.status configure -text $s
3504 .vpane.lower.diff.header.file configure -text $f
3505 .vpane.lower.diff.header.path configure -text $p
3506 foreach w $diff_actions {
3510 trace add variable current_diff write trace_current_diff
3512 frame .vpane.lower.diff.header -background orange
3513 label .vpane.lower.diff.header.status \
3514 -background orange \
3515 -width $max_status_desc \
3519 label .vpane.lower.diff.header.file \
3520 -background orange \
3524 label .vpane.lower.diff.header.path \
3525 -background orange \
3529 pack .vpane.lower.diff.header.status -side left
3530 pack .vpane.lower.diff.header.file -side left
3531 pack .vpane.lower.diff.header.path -fill x
3532 set ctxm .vpane.lower.diff.header.ctxm
3533 menu $ctxm -tearoff 0
3544 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3545 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
3549 frame .vpane.lower.diff.body
3550 set ui_diff .vpane.lower.diff.body.t
3551 text $ui_diff -background white -borderwidth 0 \
3552 -width 80 -height 15 -wrap none \
3554 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3555 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3557 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3558 -command [list $ui_diff xview]
3559 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3560 -command [list $ui_diff yview]
3561 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3562 pack .vpane.lower.diff.body.sby -side right -fill y
3563 pack $ui_diff -side left -fill both -expand 1
3564 pack .vpane.lower.diff.header -side top -fill x
3565 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3567 $ui_diff tag conf d_@ -font font_diffbold
3568 $ui_diff tag conf d_+ -foreground blue
3569 $ui_diff tag conf d_- -foreground red
3570 $ui_diff tag conf d_++ -foreground {#00a000}
3571 $ui_diff tag conf d_-- -foreground {#a000a0}
3572 $ui_diff tag conf d_+- \
3574 -background {light goldenrod yellow}
3575 $ui_diff tag conf d_-+ \
3579 # -- Diff Body Context Menu
3581 set ctxm .vpane.lower.diff.body.ctxm
3582 menu $ctxm -tearoff 0
3586 -command {tk_textCopy $ui_diff}
3587 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3589 -label {Select All} \
3591 -command {$ui_diff tag add sel 0.0 end}
3592 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3597 $ui_diff tag add sel 0.0 end
3598 tk_textCopy $ui_diff
3599 $ui_diff tag remove sel 0.0 end
3601 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3604 -label {Decrease Font Size} \
3606 -command {incr_font_size font_diff -1}
3607 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3609 -label {Increase Font Size} \
3611 -command {incr_font_size font_diff 1}
3612 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3615 -label {Show Less Context} \
3617 -command {if {$repo_config(gui.diffcontext) >= 2} {
3618 incr repo_config(gui.diffcontext) -1
3621 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3623 -label {Show More Context} \
3626 incr repo_config(gui.diffcontext)
3629 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3631 $ctxm add command -label {Options...} \
3634 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
3638 set ui_status_value {Initializing...}
3639 label .status -textvariable ui_status_value \
3645 pack .status -anchor w -side bottom -fill x
3650 set gm $repo_config(gui.geometry)
3651 wm geometry . [lindex $gm 0]
3652 .vpane sash place 0 \
3653 [lindex [.vpane sash coord 0] 0] \
3655 .vpane.files sash place 0 \
3657 [lindex [.vpane.files sash coord 0] 1]
3663 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3664 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3665 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3666 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3667 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3668 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3669 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3670 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3671 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3672 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3673 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3675 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3676 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3677 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3678 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3679 bind $ui_diff <$M1B-Key-v> {break}
3680 bind $ui_diff <$M1B-Key-V> {break}
3681 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3682 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3683 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3684 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3685 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3686 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3688 bind . <Destroy> do_quit
3689 bind all <Key-F5> do_rescan
3690 bind all <$M1B-Key-r> do_rescan
3691 bind all <$M1B-Key-R> do_rescan
3692 bind . <$M1B-Key-s> do_signoff
3693 bind . <$M1B-Key-S> do_signoff
3694 bind . <$M1B-Key-i> do_include_all
3695 bind . <$M1B-Key-I> do_include_all
3696 bind . <$M1B-Key-Return> do_commit
3697 bind all <$M1B-Key-q> do_quit
3698 bind all <$M1B-Key-Q> do_quit
3699 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3700 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3701 foreach i [list $ui_index $ui_other] {
3702 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
3703 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
3704 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
3708 set file_lists($ui_index) [list]
3709 set file_lists($ui_other) [list]
3713 set MERGE_HEAD [list]
3716 set current_branch {}
3718 set selected_commit_type new
3720 wm title . "[appname
] ([file normalize
[file dirname [gitdir
]]])"
3721 focus -force $ui_comm
3723 # -- Warn the user about environmental problems. Cygwin's Tcl
3724 # does *not* pass its env array onto any processes it spawns.
3725 # This means that git processes get none of our environment.
3730 set msg "Possible environment issues exist.
3732 The following environment variables are probably
3733 going to be ignored by any Git subprocess run
3737 foreach name [array names env] {
3738 switch -regexp -- $name {
3739 {^GIT_INDEX_FILE$} -
3740 {^GIT_OBJECT_DIRECTORY$} -
3741 {^GIT_ALTERNATE_OBJECT_DIRECTORIES$} -
3743 {^GIT_EXTERNAL_DIFF$} -
3747 {^GIT_CONFIG_LOCAL$} -
3748 {^GIT_(AUTHOR|COMMITTER)_DATE$} {
3749 append msg " - $name\n"
3752 {^GIT_(AUTHOR|COMMITTER)_(NAME|EMAIL)$} {
3753 append msg " - $name\n"
3755 set suggest_user $name
3759 if {$ignored_env > 0} {
3761 This is due to a known issue with the
3762 Tcl binary distributed by Cygwin.
"
3764 if {$suggest_user ne {}} {
3767 A good replacement
for $suggest_user
3768 is placing values
for the user.name and
3769 user.email settings into your personal
3775 unset ignored_env msg suggest_user name
3778 # -- Only initialize complex UI if we are going to stay running.
3780 if {!$single_commit} {
3784 populate_branch_menu .mbar.branch
3785 populate_fetch_menu .mbar.fetch
3786 populate_pull_menu .mbar.pull
3787 populate_push_menu .mbar.push
3790 # -- Only suggest a gc run if we are going to stay running.
3792 if {!$single_commit} {
3793 set object_limit 2000
3794 if {[is_Windows]} {set object_limit 200}
3795 regexp {^([0-9]+) objects,} [exec git count-objects] _junk objects_current
3796 if {$objects_current >= $object_limit} {
3798 "This repository currently has
$objects_current loose objects.
3800 To maintain optimal performance it is strongly
3801 recommended that you
compress the database
3802 when
more than
$object_limit loose objects exist.
3804 Compress the database now?
"] eq yes} {
3808 unset object_limit _junk objects_current
3811 lock_index begin-read