2 # Tcl ignores the next line -*- tcl -*- \
5 # Copyright (C) 2006 Shawn Pearce, Paul Mackerras. All rights reserved.
6 # This program is free software; it may be used, copied, modified
7 # and distributed under the terms of the GNU General Public Licence,
8 # either version 2, or (at your option) any later version.
10 set appname
[lindex
[file split $argv0] end
]
13 ######################################################################
17 proc is_many_config
{name
} {
18 switch
-glob -- $name {
27 proc load_config
{include_global
} {
28 global repo_config global_config default_config
30 array
unset global_config
31 if {$include_global} {
33 set fd_rc
[open
"| git repo-config --global --list" r
]
34 while {[gets
$fd_rc line
] >= 0} {
35 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
36 if {[is_many_config
$name]} {
37 lappend global_config
($name) $value
39 set global_config
($name) $value
47 array
unset repo_config
49 set fd_rc
[open
"| git repo-config --list" r
]
50 while {[gets
$fd_rc line
] >= 0} {
51 if {[regexp
{^
([^
=]+)=(.
*)$
} $line line name value
]} {
52 if {[is_many_config
$name]} {
53 lappend repo_config
($name) $value
55 set repo_config
($name) $value
62 foreach name
[array names default_config
] {
63 if {[catch
{set v
$global_config($name)}]} {
64 set global_config
($name) $default_config($name)
66 if {[catch
{set v
$repo_config($name)}]} {
67 set repo_config
($name) $default_config($name)
73 global default_config font_descs
74 global repo_config global_config
75 global repo_config_new global_config_new
77 foreach option
$font_descs {
78 set name
[lindex
$option 0]
79 set font
[lindex
$option 1]
80 font configure
$font \
81 -family $global_config_new(gui.
$font^^family
) \
82 -size $global_config_new(gui.
$font^^size
)
83 font configure
${font}bold \
84 -family $global_config_new(gui.
$font^^family
) \
85 -size $global_config_new(gui.
$font^^size
)
86 set global_config_new
(gui.
$name) [font configure
$font]
87 unset global_config_new
(gui.
$font^^family
)
88 unset global_config_new
(gui.
$font^^size
)
91 foreach name
[array names default_config
] {
92 set value
$global_config_new($name)
93 if {$value ne
$global_config($name)} {
94 if {$value eq
$default_config($name)} {
95 catch
{exec git repo-config
--global --unset $name}
97 regsub
-all "\[{}\]" $value {"} value
98 exec git repo-config --global $name $value
100 set global_config($name) $value
101 if {$value eq $repo_config($name)} {
102 catch {exec git repo-config --unset $name}
103 set repo_config($name) $value
108 foreach name [array names default_config] {
109 set value $repo_config_new($name)
110 if {$value ne $repo_config($name)} {
111 if {$value eq $global_config($name)} {
112 catch {exec git repo-config --unset $name}
114 regsub -all "\
[{}\
]" $value {"} value
115 exec git repo-config
$name $value
117 set repo_config
($name) $value
122 proc error_popup
{msg
} {
123 global gitdir appname
128 append title
[lindex \
129 [file split [file normalize
[file dirname $gitdir]]] \
133 set cmd
[list tk_messageBox \
136 -title "$title: error" \
138 if {[winfo ismapped .
]} {
139 lappend cmd
-parent .
144 proc info_popup
{msg
} {
145 global gitdir appname
150 append title
[lindex \
151 [file split [file normalize
[file dirname $gitdir]]] \
163 ######################################################################
167 if { [catch
{set gitdir
$env(GIT_DIR
)}]
168 && [catch
{set gitdir
[exec git rev-parse
--git-dir]} err
]} {
169 catch
{wm withdraw .
}
170 error_popup
"Cannot find the git directory:\n\n$err"
173 if {![file isdirectory
$gitdir]} {
174 catch
{wm withdraw .
}
175 error_popup
"Git directory not found:\n\n$gitdir"
178 if {[lindex
[file split $gitdir] end
] ne
{.git
}} {
179 catch
{wm withdraw .
}
180 error_popup
"Cannot use funny .git directory:\n\n$gitdir"
183 if {[catch
{cd [file dirname $gitdir]} err
]} {
184 catch
{wm withdraw .
}
185 error_popup
"No working directory [file dirname $gitdir]:\n\n$err"
190 if {$appname eq
{git-citool
}} {
194 ######################################################################
202 set disable_on_lock
[list
]
203 set index_lock_type none
205 proc lock_index
{type} {
206 global index_lock_type disable_on_lock
208 if {$index_lock_type eq
{none
}} {
209 set index_lock_type
$type
210 foreach w
$disable_on_lock {
211 uplevel
#0 $w disabled
214 } elseif
{$index_lock_type eq
"begin-$type"} {
215 set index_lock_type
$type
221 proc unlock_index
{} {
222 global index_lock_type disable_on_lock
224 set index_lock_type none
225 foreach w
$disable_on_lock {
230 ######################################################################
234 proc repository_state
{ctvar hdvar mhvar
} {
236 upvar
$ctvar ct
$hdvar hd
$mhvar mh
240 if {[catch
{set hd
[exec git rev-parse
--verify HEAD
]}]} {
246 set merge_head
[file join $gitdir MERGE_HEAD
]
247 if {[file exists
$merge_head]} {
249 set fd_mh
[open
$merge_head r
]
250 while {[gets
$fd_mh line
] >= 0} {
261 global PARENT empty_tree
263 set p
[lindex
$PARENT 0]
267 if {$empty_tree eq
{}} {
268 set empty_tree
[exec git mktree
<< {}]
273 proc rescan
{after
} {
274 global HEAD PARENT MERGE_HEAD commit_type
275 global ui_index ui_other ui_status_value ui_comm
276 global rescan_active file_states
279 if {$rescan_active > 0 ||
![lock_index
read]} return
281 repository_state newType newHEAD newMERGE_HEAD
282 if {[string match amend
* $commit_type]
283 && $newType eq
{normal
}
284 && $newHEAD eq
$HEAD} {
288 set MERGE_HEAD
$newMERGE_HEAD
289 set commit_type
$newType
292 array
unset file_states
294 if {![$ui_comm edit modified
]
295 ||
[string trim
[$ui_comm get
0.0 end
]] eq
{}} {
296 if {[load_message GITGUI_MSG
]} {
297 } elseif
{[load_message MERGE_MSG
]} {
298 } elseif
{[load_message SQUASH_MSG
]} {
301 $ui_comm edit modified false
304 if {$repo_config(gui.trustmtime
) eq
{true
}} {
305 rescan_stage2
{} $after
308 set ui_status_value
{Refreshing
file status...
}
309 set cmd
[list git update-index
]
311 lappend cmd
--unmerged
312 lappend cmd
--ignore-missing
313 lappend cmd
--refresh
314 set fd_rf
[open
"| $cmd" r
]
315 fconfigure
$fd_rf -blocking 0 -translation binary
316 fileevent
$fd_rf readable \
317 [list rescan_stage2
$fd_rf $after]
321 proc rescan_stage2
{fd after
} {
322 global gitdir ui_status_value
323 global rescan_active buf_rdi buf_rdf buf_rlo
327 if {![eof
$fd]} return
331 set ls_others
[list | git ls-files
--others -z \
332 --exclude-per-directory=.gitignore
]
333 set info_exclude
[file join $gitdir info exclude
]
334 if {[file readable
$info_exclude]} {
335 lappend ls_others
"--exclude-from=$info_exclude"
343 set ui_status_value
{Scanning
for modified files ...
}
344 set fd_di
[open
"| git diff-index --cached -z [PARENT]" r
]
345 set fd_df
[open
"| git diff-files -z" r
]
346 set fd_lo
[open
$ls_others r
]
348 fconfigure
$fd_di -blocking 0 -translation binary
349 fconfigure
$fd_df -blocking 0 -translation binary
350 fconfigure
$fd_lo -blocking 0 -translation binary
351 fileevent
$fd_di readable
[list read_diff_index
$fd_di $after]
352 fileevent
$fd_df readable
[list read_diff_files
$fd_df $after]
353 fileevent
$fd_lo readable
[list read_ls_others
$fd_lo $after]
356 proc load_message
{file} {
357 global gitdir ui_comm
359 set f
[file join $gitdir $file]
360 if {[file isfile
$f]} {
361 if {[catch
{set fd
[open
$f r
]}]} {
364 set content
[string trim
[read $fd]]
366 $ui_comm delete
0.0 end
367 $ui_comm insert end
$content
373 proc read_diff_index
{fd after
} {
376 append buf_rdi
[read $fd]
378 set n
[string length
$buf_rdi]
380 set z1
[string first
"\0" $buf_rdi $c]
383 set z2
[string first
"\0" $buf_rdi $z1]
387 set i
[split [string range
$buf_rdi $c [expr {$z1 - 2}]] { }]
389 [string range
$buf_rdi $z1 [expr {$z2 - 1}]] \
391 [list
[lindex
$i 0] [lindex
$i 2]] \
397 set buf_rdi
[string range
$buf_rdi $c end
]
402 rescan_done
$fd buf_rdi
$after
405 proc read_diff_files
{fd after
} {
408 append buf_rdf
[read $fd]
410 set n
[string length
$buf_rdf]
412 set z1
[string first
"\0" $buf_rdf $c]
415 set z2
[string first
"\0" $buf_rdf $z1]
419 set i
[split [string range
$buf_rdf $c [expr {$z1 - 2}]] { }]
421 [string range
$buf_rdf $z1 [expr {$z2 - 1}]] \
424 [list
[lindex
$i 0] [lindex
$i 2]]
429 set buf_rdf
[string range
$buf_rdf $c end
]
434 rescan_done
$fd buf_rdf
$after
437 proc read_ls_others
{fd after
} {
440 append buf_rlo
[read $fd]
441 set pck
[split $buf_rlo "\0"]
442 set buf_rlo
[lindex
$pck end
]
443 foreach p
[lrange
$pck 0 end-1
] {
446 rescan_done
$fd buf_rlo
$after
449 proc rescan_done
{fd buf after
} {
451 global file_states repo_config
454 if {![eof
$fd]} return
457 if {[incr rescan_active
-1] > 0} return
463 if {$repo_config(gui.partialinclude
) ne
{true
}} {
465 foreach path
[array names file_states
] {
466 switch
-- [lindex
$file_states($path) 0] {
468 MM
{lappend pathList
$path}
471 if {$pathList ne
{}} {
473 "Updating included files" \
475 [concat
{reshow_diff
;} $after]
484 proc prune_selection
{} {
485 global file_states selected_paths
487 foreach path
[array names selected_paths
] {
488 if {[catch
{set still_here
$file_states($path)}]} {
489 unset selected_paths
($path)
494 ######################################################################
499 global ui_diff current_diff ui_index ui_other
501 $ui_diff conf
-state normal
502 $ui_diff delete
0.0 end
503 $ui_diff conf
-state disabled
507 $ui_index tag remove in_diff
0.0 end
508 $ui_other tag remove in_diff
0.0 end
511 proc reshow_diff
{} {
512 global current_diff ui_status_value file_states
514 if {$current_diff eq
{}
515 ||
[catch
{set s
$file_states($current_diff)}]} {
518 show_diff
$current_diff
522 proc handle_empty_diff
{} {
523 global current_diff file_states file_lists
525 set path
$current_diff
526 set s
$file_states($path)
527 if {[lindex
$s 0] ne
{_M
}} return
529 info_popup
"No differences detected.
531 [short_path $path] has no changes.
533 The modification date of this file was updated
534 by another application and you currently have
535 the Trust File Modification Timestamps option
536 enabled, so Git did not automatically detect
537 that there are no content differences in this
540 This file will now be removed from the modified
541 files list, to prevent possible confusion.
543 if {[catch
{exec git update-index
-- $path} err
]} {
544 error_popup
"Failed to refresh index:\n\n$err"
548 set old_w
[mapcol
[lindex
$file_states($path) 0] $path]
549 set lno
[lsearch
-sorted $file_lists($old_w) $path]
551 set file_lists
($old_w) \
552 [lreplace
$file_lists($old_w) $lno $lno]
554 $old_w conf
-state normal
555 $old_w delete
$lno.0 [expr {$lno + 1}].0
556 $old_w conf
-state disabled
560 proc show_diff
{path
{w
{}} {lno
{}}} {
561 global file_states file_lists
562 global is_3way_diff diff_active repo_config
563 global ui_diff current_diff ui_status_value
565 if {$diff_active ||
![lock_index
read]} return
568 if {$w eq
{} ||
$lno == {}} {
569 foreach w
[array names file_lists
] {
570 set lno
[lsearch
-sorted $file_lists($w) $path]
577 if {$w ne
{} && $lno >= 1} {
578 $w tag add in_diff
$lno.0 [expr {$lno + 1}].0
581 set s
$file_states($path)
585 set current_diff
$path
586 set ui_status_value
"Loading diff of [escape_path $path]..."
588 set cmd
[list | git diff-index
]
589 lappend cmd
--no-color
590 if {$repo_config(gui.diffcontext
) > 0} {
591 lappend cmd
"-U$repo_config(gui.diffcontext)"
601 set fd
[open
$path r
]
602 set content
[read $fd]
607 set ui_status_value
"Unable to display [escape_path $path]"
608 error_popup
"Error loading file:\n\n$err"
611 $ui_diff conf
-state normal
612 $ui_diff insert end
$content
613 $ui_diff conf
-state disabled
616 set ui_status_value
{Ready.
}
625 if {[catch
{set fd
[open
$cmd r
]} err
]} {
628 set ui_status_value
"Unable to display [escape_path $path]"
629 error_popup
"Error loading diff:\n\n$err"
633 fconfigure
$fd -blocking 0 -translation auto
634 fileevent
$fd readable
[list read_diff
$fd]
637 proc read_diff
{fd
} {
638 global ui_diff ui_status_value is_3way_diff diff_active
641 $ui_diff conf
-state normal
642 while {[gets
$fd line
] >= 0} {
643 # -- Cleanup uninteresting diff header lines.
645 if {[string match
{diff --git *} $line]} continue
646 if {[string match
{diff --combined *} $line]} continue
647 if {[string match
{--- *} $line]} continue
648 if {[string match
{+++ *} $line]} continue
649 if {$line eq
{deleted
file mode
120000}} {
650 set line
"deleted symlink"
653 # -- Automatically detect if this is a 3 way diff.
655 if {[string match
{@@@
*} $line]} {set is_3way_diff
1}
657 # -- Reformat a 3 way diff, 'cause its too weird.
660 set op
[string range
$line 0 1]
663 {++} {set tags d_
+ ; set op
{ +}}
664 {--} {set tags d_-
; set op
{ -}}
665 { +} {set tags d_
++; set op
{++}}
666 { -} {set tags d_--
; set op
{--}}
667 {+ } {set tags d_-
+; set op
{-+}}
668 {- } {set tags d_
+-; set op
{+-}}
669 default
{set tags
{}}
671 set line
[string replace
$line 0 1 $op]
673 switch
-- [string index
$line 0] {
677 default
{set tags
{}}
680 $ui_diff insert end
$line $tags
681 $ui_diff insert end
"\n" $tags
683 $ui_diff conf
-state disabled
689 set ui_status_value
{Ready.
}
691 if {$repo_config(gui.trustmtime
) eq
{true
}
692 && [$ui_diff index end
] eq
{2.0}} {
698 ######################################################################
702 proc load_last_commit
{} {
703 global HEAD PARENT MERGE_HEAD commit_type ui_comm
705 if {[llength
$PARENT] == 0} {
706 error_popup
{There is nothing to amend.
708 You are about to create the initial commit.
709 There is no commit before this to amend.
714 repository_state curType curHEAD curMERGE_HEAD
715 if {$curType eq
{merge
}} {
716 error_popup
{Cannot amend
while merging.
718 You are currently
in the middle of a merge that
719 has not been fully completed. You cannot amend
720 the prior commit unless you first abort the
721 current merge activity.
729 set fd
[open
"| git cat-file commit $curHEAD" r
]
730 while {[gets
$fd line
] > 0} {
731 if {[string match
{parent
*} $line]} {
732 lappend parents
[string range
$line 7 end
]
735 set msg
[string trim
[read $fd]]
738 error_popup
"Error loading commit data for amend:\n\n$err"
744 set MERGE_HEAD
[list
]
745 switch
-- [llength
$parents] {
746 0 {set commit_type amend-initial
}
747 1 {set commit_type amend
}
748 default
{set commit_type amend-merge
}
751 $ui_comm delete
0.0 end
752 $ui_comm insert end
$msg
754 $ui_comm edit modified false
755 rescan
{set ui_status_value
{Ready.
}}
758 proc create_new_commit
{} {
759 global commit_type ui_comm
761 set commit_type normal
762 $ui_comm delete
0.0 end
764 $ui_comm edit modified false
765 rescan
{set ui_status_value
{Ready.
}}
768 set GIT_COMMITTER_IDENT
{}
770 proc committer_ident
{} {
771 global GIT_COMMITTER_IDENT
773 if {$GIT_COMMITTER_IDENT eq
{}} {
774 if {[catch
{set me
[exec git var GIT_COMMITTER_IDENT
]} err
]} {
775 error_popup
"Unable to obtain your identity:\n\n$err"
778 if {![regexp
{^
(.
*) [0-9]+ [-+0-9]+$
} \
779 $me me GIT_COMMITTER_IDENT
]} {
780 error_popup
"Invalid GIT_COMMITTER_IDENT:\n\n$me"
785 return $GIT_COMMITTER_IDENT
788 proc commit_tree
{} {
789 global HEAD commit_type file_states ui_comm repo_config
791 if {![lock_index update
]} return
792 if {[committer_ident
] eq
{}} return
794 # -- Our in memory state should match the repository.
796 repository_state curType curHEAD curMERGE_HEAD
797 if {[string match amend
* $commit_type]
798 && $curType eq
{normal
}
799 && $curHEAD eq
$HEAD} {
800 } elseif
{$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
801 info_popup
{Last scanned state does not match repository state.
803 Another Git program has modified this repository
804 since the last scan. A rescan must be performed
805 before another commit can be created.
807 The rescan will be automatically started now.
810 rescan
{set ui_status_value
{Ready.
}}
814 # -- At least one file should differ in the index.
817 foreach path
[array names file_states
] {
818 switch
-glob -- [lindex
$file_states($path) 0] {
822 M?
{set files_ready
1; break}
824 error_popup
"Unmerged files cannot be committed.
826 File [short_path $path] has merge conflicts.
827 You must resolve them and include the file before committing.
833 error_popup
"Unknown file state [lindex $s 0] detected.
835 File [short_path $path] cannot be committed by this program.
841 error_popup
{No included files to commit.
843 You must include
at least
1 file before you can commit.
849 # -- A message is required.
851 set msg
[string trim
[$ui_comm get
1.0 end
]]
853 error_popup
{Please supply a commit message.
855 A good commit message has the following format
:
857 - First line
: Describe
in one sentance what you did.
859 - Remaining lines
: Describe why this change is good.
865 # -- Update included files if partialincludes are off.
867 if {$repo_config(gui.partialinclude
) ne
{true
}} {
869 foreach path
[array names file_states
] {
870 switch
-glob -- [lindex
$file_states($path) 0] {
872 M?
{lappend pathList
$path}
875 if {$pathList ne
{}} {
878 "Updating included files" \
880 [concat
{lock_index update
;} \
881 [list commit_prehook
$curHEAD $msg]]
886 commit_prehook
$curHEAD $msg
889 proc commit_prehook
{curHEAD msg
} {
890 global tcl_platform gitdir ui_status_value pch_error
892 # On Cygwin [file executable] might lie so we need to ask
893 # the shell if the hook is executable. Yes that's annoying.
895 set pchook
[file join $gitdir hooks pre-commit
]
896 if {$tcl_platform(platform
) eq
{windows
}
897 && [file isfile
$pchook]} {
898 set pchook
[list sh
-c [concat \
899 "if test -x \"$pchook\";" \
900 "then exec \"$pchook\" 2>&1;" \
902 } elseif
{[file executable
$pchook]} {
903 set pchook
[list
$pchook |
& cat]
905 commit_writetree
$curHEAD $msg
909 set ui_status_value
{Calling pre-commit hook...
}
911 set fd_ph
[open
"| $pchook" r
]
912 fconfigure
$fd_ph -blocking 0 -translation binary
913 fileevent
$fd_ph readable \
914 [list commit_prehook_wait
$fd_ph $curHEAD $msg]
917 proc commit_prehook_wait
{fd_ph curHEAD msg
} {
918 global pch_error ui_status_value
920 append pch_error
[read $fd_ph]
921 fconfigure
$fd_ph -blocking 1
923 if {[catch
{close
$fd_ph}]} {
924 set ui_status_value
{Commit declined by pre-commit hook.
}
925 hook_failed_popup pre-commit
$pch_error
928 commit_writetree
$curHEAD $msg
933 fconfigure
$fd_ph -blocking 0
936 proc commit_writetree
{curHEAD msg
} {
937 global ui_status_value
939 set ui_status_value
{Committing changes...
}
940 set fd_wt
[open
"| git write-tree" r
]
941 fileevent
$fd_wt readable \
942 [list commit_committree
$fd_wt $curHEAD $msg]
945 proc commit_committree
{fd_wt curHEAD msg
} {
946 global HEAD PARENT MERGE_HEAD commit_type
947 global single_commit gitdir tcl_platform
948 global ui_status_value ui_comm selected_commit_type
949 global file_states selected_paths rescan_active
952 if {$tree_id eq
{} ||
[catch
{close
$fd_wt} err
]} {
953 error_popup
"write-tree failed:\n\n$err"
954 set ui_status_value
{Commit failed.
}
959 # -- Create the commit.
961 set cmd
[list git commit-tree
$tree_id]
962 set parents
[concat
$PARENT $MERGE_HEAD]
963 if {[llength
$parents] > 0} {
968 # git commit-tree writes to stderr during initial commit.
969 lappend cmd
2>/dev
/null
972 if {[catch
{set cmt_id
[eval exec $cmd]} err
]} {
973 error_popup
"commit-tree failed:\n\n$err"
974 set ui_status_value
{Commit failed.
}
979 # -- Update the HEAD ref.
982 if {$commit_type ne
{normal
}} {
983 append reflogm
" ($commit_type)"
985 set i
[string first
"\n" $msg]
987 append reflogm
{: } [string range
$msg 0 [expr {$i - 1}]]
989 append reflogm
{: } $msg
991 set cmd
[list git update-ref
-m $reflogm HEAD
$cmt_id $curHEAD]
992 if {[catch
{eval exec $cmd} err
]} {
993 error_popup
"update-ref failed:\n\n$err"
994 set ui_status_value
{Commit failed.
}
999 # -- Cleanup after ourselves.
1001 catch
{file delete
[file join $gitdir MERGE_HEAD
]}
1002 catch
{file delete
[file join $gitdir MERGE_MSG
]}
1003 catch
{file delete
[file join $gitdir SQUASH_MSG
]}
1004 catch
{file delete
[file join $gitdir GITGUI_MSG
]}
1006 # -- Let rerere do its thing.
1008 if {[file isdirectory
[file join $gitdir rr-cache
]]} {
1009 catch
{exec git rerere
}
1012 # -- Run the post-commit hook.
1014 set pchook
[file join $gitdir hooks post-commit
]
1015 if {$tcl_platform(platform
) eq
{windows
} && [file isfile
$pchook]} {
1016 set pchook
[list sh
-c [concat \
1017 "if test -x \"$pchook\";" \
1018 "then exec \"$pchook\";" \
1020 } elseif
{![file executable
$pchook]} {
1023 if {$pchook ne
{}} {
1024 catch
{exec $pchook &}
1027 $ui_comm delete
0.0 end
1029 $ui_comm edit modified false
1031 if {$single_commit} do_quit
1033 # -- Update in memory status
1035 set selected_commit_type new
1036 set commit_type normal
1039 set MERGE_HEAD
[list
]
1041 foreach path
[array names file_states
] {
1042 set s
$file_states($path)
1044 switch
-glob -- $m {
1052 unset file_states
($path)
1053 catch
{unset selected_paths
($path)}
1056 set file_states
($path) [list _O
[lindex
$s 1] {} {}]
1062 set file_states
($path) [list \
1063 _
[string index
$m 1] \
1074 set ui_status_value \
1075 "Changes committed as [string range $cmt_id 0 7]."
1078 ######################################################################
1082 proc fetch_from
{remote
} {
1083 set w
[new_console
"fetch $remote" \
1084 "Fetching new changes from $remote"]
1085 set cmd
[list git fetch
]
1087 console_exec
$w $cmd
1090 proc pull_remote
{remote branch
} {
1091 global HEAD commit_type file_states repo_config
1093 if {![lock_index update
]} return
1095 # -- Our in memory state should match the repository.
1097 repository_state curType curHEAD curMERGE_HEAD
1098 if {$commit_type ne
$curType ||
$HEAD ne
$curHEAD} {
1099 error_popup
{Last scanned state does not match repository state.
1101 Its highly likely that another Git program modified the
1102 repository since our last scan. A rescan is required
1103 before a pull can be started.
1106 rescan
{set ui_status_value
{Ready.
}}
1110 # -- No differences should exist before a pull.
1112 if {[array size file_states
] != 0} {
1113 error_popup
{Uncommitted but modified files are present.
1115 You should not perform a pull with unmodified files
in your working
1116 directory as Git would be unable to recover from an incorrect merge.
1118 Commit or throw away all changes before starting a pull operation.
1124 set w
[new_console
"pull $remote $branch" \
1125 "Pulling new changes from branch $branch in $remote"]
1126 set cmd
[list git pull
]
1127 if {$repo_config(gui.pullsummary
) eq
{false
}} {
1128 lappend cmd
--no-summary
1132 console_exec
$w $cmd [list post_pull_remote
$remote $branch]
1135 proc post_pull_remote
{remote branch success
} {
1136 global HEAD PARENT MERGE_HEAD commit_type selected_commit_type
1137 global ui_status_value
1141 repository_state commit_type HEAD MERGE_HEAD
1143 set selected_commit_type new
1144 set ui_status_value
"Pulling $branch from $remote complete."
1146 rescan
[list
set ui_status_value \
1147 "Conflicts detected while pulling $branch from $remote."]
1151 proc push_to
{remote
} {
1152 set w
[new_console
"push $remote" \
1153 "Pushing changes to $remote"]
1154 set cmd
[list git push
]
1156 console_exec
$w $cmd
1159 ######################################################################
1163 proc mapcol
{state path
} {
1164 global all_cols ui_other
1166 if {[catch
{set r
$all_cols($state)}]} {
1167 puts
"error: no column for state={$state} $path"
1173 proc mapicon
{state path
} {
1176 if {[catch
{set r
$all_icons($state)}]} {
1177 puts
"error: no icon for state={$state} $path"
1183 proc mapdesc
{state path
} {
1186 if {[catch
{set r
$all_descs($state)}]} {
1187 puts
"error: no desc for state={$state} $path"
1193 proc escape_path
{path
} {
1194 regsub
-all "\n" $path "\\n" path
1198 proc short_path
{path
} {
1199 return [escape_path
[lindex
[file split $path] end
]]
1203 set null_sha1
[string repeat
0 40]
1205 proc merge_state
{path new_state
{head_info
{}} {index_info
{}}} {
1206 global file_states next_icon_id null_sha1
1208 set s0
[string index
$new_state 0]
1209 set s1
[string index
$new_state 1]
1211 if {[catch
{set info
$file_states($path)}]} {
1213 set icon n
[incr next_icon_id
]
1215 set state
[lindex
$info 0]
1216 set icon
[lindex
$info 1]
1217 if {$head_info eq
{}} {set head_info
[lindex
$info 2]}
1218 if {$index_info eq
{}} {set index_info
[lindex
$info 3]}
1221 if {$s0 eq
{?
}} {set s0
[string index
$state 0]} \
1222 elseif
{$s0 eq
{_
}} {set s0 _
}
1224 if {$s1 eq
{?
}} {set s1
[string index
$state 1]} \
1225 elseif
{$s1 eq
{_
}} {set s1 _
}
1227 if {$s0 eq
{A
} && $s1 eq
{_
} && $head_info eq
{}} {
1228 set head_info
[list
0 $null_sha1]
1229 } elseif
{$s0 ne
{_
} && [string index
$state 0] eq
{_
}
1230 && $head_info eq
{}} {
1231 set head_info
$index_info
1234 set file_states
($path) [list
$s0$s1 $icon \
1235 $head_info $index_info \
1240 proc display_file
{path state
} {
1241 global file_states file_lists selected_paths
1243 set old_m
[merge_state
$path $state]
1244 set s
$file_states($path)
1245 set new_m
[lindex
$s 0]
1246 set new_w
[mapcol
$new_m $path]
1247 set old_w
[mapcol
$old_m $path]
1248 set new_icon
[mapicon
$new_m $path]
1250 if {$new_w ne
$old_w} {
1251 set lno
[lsearch
-sorted $file_lists($old_w) $path]
1254 $old_w conf
-state normal
1255 $old_w delete
$lno.0 [expr {$lno + 1}].0
1256 $old_w conf
-state disabled
1259 lappend file_lists
($new_w) $path
1260 set file_lists
($new_w) [lsort
$file_lists($new_w)]
1261 set lno
[lsearch
-sorted $file_lists($new_w) $path]
1263 $new_w conf
-state normal
1264 $new_w image create
$lno.0 \
1265 -align center
-padx 5 -pady 1 \
1266 -name [lindex
$s 1] \
1268 $new_w insert
$lno.1 "[escape_path $path]\n"
1269 if {[catch
{set in_sel
$selected_paths($path)}]} {
1273 $new_w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1275 $new_w conf
-state disabled
1276 } elseif
{$new_icon ne
[mapicon
$old_m $path]} {
1277 $new_w conf
-state normal
1278 $new_w image conf
[lindex
$s 1] -image $new_icon
1279 $new_w conf
-state disabled
1283 proc display_all_files
{} {
1284 global ui_index ui_other
1285 global file_states file_lists
1286 global last_clicked selected_paths
1288 $ui_index conf
-state normal
1289 $ui_other conf
-state normal
1291 $ui_index delete
0.0 end
1292 $ui_other delete
0.0 end
1295 set file_lists
($ui_index) [list
]
1296 set file_lists
($ui_other) [list
]
1298 foreach path
[lsort
[array names file_states
]] {
1299 set s
$file_states($path)
1301 set w
[mapcol
$m $path]
1302 lappend file_lists
($w) $path
1303 set lno
[expr {[lindex
[split [$w index end
] .
] 0] - 1}]
1304 $w image create end \
1305 -align center
-padx 5 -pady 1 \
1306 -name [lindex
$s 1] \
1307 -image [mapicon
$m $path]
1308 $w insert end
"[escape_path $path]\n"
1309 if {[catch
{set in_sel
$selected_paths($path)}]} {
1313 $w tag add in_sel
$lno.0 [expr {$lno + 1}].0
1317 $ui_index conf
-state disabled
1318 $ui_other conf
-state disabled
1321 proc update_indexinfo
{msg pathList after
} {
1322 global update_index_cp ui_status_value
1324 if {![lock_index update
]} return
1326 set update_index_cp
0
1327 set pathList
[lsort
$pathList]
1328 set totalCnt
[llength
$pathList]
1329 set batch [expr {int
($totalCnt * .01) + 1}]
1330 if {$batch > 25} {set batch 25}
1332 set ui_status_value
[format \
1333 "$msg... %i/%i files (%.2f%%)" \
1337 set fd
[open
"| git update-index -z --index-info" w
]
1343 fileevent
$fd writable
[list \
1344 write_update_indexinfo \
1354 proc write_update_indexinfo
{fd pathList totalCnt
batch msg after
} {
1355 global update_index_cp ui_status_value
1356 global file_states current_diff
1358 if {$update_index_cp >= $totalCnt} {
1365 for {set i
$batch} \
1366 {$update_index_cp < $totalCnt && $i > 0} \
1368 set path
[lindex
$pathList $update_index_cp]
1369 incr update_index_cp
1371 set s
$file_states($path)
1372 switch
-glob -- [lindex
$s 0] {
1378 set info
[lindex
$s 2]
1379 if {$info eq
{}} continue
1381 puts
-nonewline $fd $info
1382 puts
-nonewline $fd "\t"
1383 puts
-nonewline $fd $path
1384 puts
-nonewline $fd "\0"
1385 display_file
$path $new
1388 set ui_status_value
[format \
1389 "$msg... %i/%i files (%.2f%%)" \
1392 [expr {100.0 * $update_index_cp / $totalCnt}]]
1395 proc update_index
{msg pathList after
} {
1396 global update_index_cp ui_status_value
1398 if {![lock_index update
]} return
1400 set update_index_cp
0
1401 set pathList
[lsort
$pathList]
1402 set totalCnt
[llength
$pathList]
1403 set batch [expr {int
($totalCnt * .01) + 1}]
1404 if {$batch > 25} {set batch 25}
1406 set ui_status_value
[format \
1407 "$msg... %i/%i files (%.2f%%)" \
1411 set fd
[open
"| git update-index --add --remove -z --stdin" w
]
1417 fileevent
$fd writable
[list \
1418 write_update_index \
1428 proc write_update_index
{fd pathList totalCnt
batch msg after
} {
1429 global update_index_cp ui_status_value
1430 global file_states current_diff
1432 if {$update_index_cp >= $totalCnt} {
1439 for {set i
$batch} \
1440 {$update_index_cp < $totalCnt && $i > 0} \
1442 set path
[lindex
$pathList $update_index_cp]
1443 incr update_index_cp
1445 switch
-glob -- [lindex
$file_states($path) 0] {
1461 puts
-nonewline $fd $path
1462 puts
-nonewline $fd "\0"
1463 display_file
$path $new
1466 set ui_status_value
[format \
1467 "$msg... %i/%i files (%.2f%%)" \
1470 [expr {100.0 * $update_index_cp / $totalCnt}]]
1473 ######################################################################
1475 ## remote management
1477 proc load_all_remotes
{} {
1478 global gitdir all_remotes repo_config
1480 set all_remotes
[list
]
1481 set rm_dir
[file join $gitdir remotes
]
1482 if {[file isdirectory
$rm_dir]} {
1483 set all_remotes
[concat
$all_remotes [glob \
1487 -directory $rm_dir *]]
1490 foreach line
[array names repo_config remote.
*.url
] {
1491 if {[regexp ^remote\.
(.
*)\.url\$
$line line name
]} {
1492 lappend all_remotes
$name
1496 set all_remotes
[lsort
-unique $all_remotes]
1499 proc populate_fetch_menu
{m
} {
1500 global gitdir all_remotes repo_config
1502 foreach r
$all_remotes {
1504 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1505 if {![catch
{set a
$repo_config(remote.
$r.fetch
)}]} {
1510 set fd
[open
[file join $gitdir remotes
$r] r
]
1511 while {[gets
$fd n
] >= 0} {
1512 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $n]} {
1523 -label "Fetch from $r..." \
1524 -command [list fetch_from
$r] \
1530 proc populate_push_menu
{m
} {
1531 global gitdir all_remotes repo_config
1533 foreach r
$all_remotes {
1535 if {![catch
{set a
$repo_config(remote.
$r.url
)}]} {
1536 if {![catch
{set a
$repo_config(remote.
$r.push
)}]} {
1541 set fd
[open
[file join $gitdir remotes
$r] r
]
1542 while {[gets
$fd n
] >= 0} {
1543 if {[regexp
{^Push
:[ \t]*([^
:]+):} $n]} {
1554 -label "Push to $r..." \
1555 -command [list push_to
$r] \
1561 proc populate_pull_menu
{m
} {
1562 global gitdir repo_config all_remotes disable_on_lock
1564 foreach remote
$all_remotes {
1566 if {[array get repo_config remote.
$remote.url
] ne
{}} {
1567 if {[array get repo_config remote.
$remote.fetch
] ne
{}} {
1568 regexp
{^
([^
:]+):} \
1569 [lindex
$repo_config(remote.
$remote.fetch
) 0] \
1574 set fd
[open
[file join $gitdir remotes
$remote] r
]
1575 while {[gets
$fd line
] >= 0} {
1576 if {[regexp
{^Pull
:[ \t]*([^
:]+):} $line line rb
]} {
1585 regsub ^refs
/heads
/ $rb {} rb_short
1586 if {$rb_short ne
{}} {
1588 -label "Branch $rb_short from $remote..." \
1589 -command [list pull_remote
$remote $rb] \
1591 lappend disable_on_lock \
1592 [list
$m entryconf
[$m index last
] -state]
1597 ######################################################################
1602 #define mask_width 14
1603 #define mask_height 15
1604 static unsigned char mask_bits
[] = {
1605 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1606 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1607 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1610 image create bitmap file_plain
-background white
-foreground black
-data {
1611 #define plain_width 14
1612 #define plain_height 15
1613 static unsigned char plain_bits
[] = {
1614 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1615 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1616 0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1617 } -maskdata $filemask
1619 image create bitmap file_mod
-background white
-foreground blue
-data {
1620 #define mod_width 14
1621 #define mod_height 15
1622 static unsigned char mod_bits
[] = {
1623 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1624 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1625 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1626 } -maskdata $filemask
1628 image create bitmap file_fulltick
-background white
-foreground "#007000" -data {
1629 #define file_fulltick_width 14
1630 #define file_fulltick_height 15
1631 static unsigned char file_fulltick_bits
[] = {
1632 0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1633 0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1634 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1635 } -maskdata $filemask
1637 image create bitmap file_parttick
-background white
-foreground "#005050" -data {
1638 #define parttick_width 14
1639 #define parttick_height 15
1640 static unsigned char parttick_bits
[] = {
1641 0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1642 0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1643 0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1644 } -maskdata $filemask
1646 image create bitmap file_question
-background white
-foreground black
-data {
1647 #define file_question_width 14
1648 #define file_question_height 15
1649 static unsigned char file_question_bits
[] = {
1650 0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1651 0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1652 0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1653 } -maskdata $filemask
1655 image create bitmap file_removed
-background white
-foreground red
-data {
1656 #define file_removed_width 14
1657 #define file_removed_height 15
1658 static unsigned char file_removed_bits
[] = {
1659 0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1660 0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1661 0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1662 } -maskdata $filemask
1664 image create bitmap file_merge
-background white
-foreground blue
-data {
1665 #define file_merge_width 14
1666 #define file_merge_height 15
1667 static unsigned char file_merge_bits
[] = {
1668 0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1669 0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1670 0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1671 } -maskdata $filemask
1673 set ui_index .vpane.files.index.list
1674 set ui_other .vpane.files.other.list
1675 set max_status_desc
0
1677 {__ i plain
"Unmodified"}
1678 {_M i mod
"Modified"}
1679 {M_ i fulltick
"Included in commit"}
1680 {MM i parttick
"Partially included"}
1682 {_O o plain
"Untracked"}
1683 {A_ o fulltick
"Added by commit"}
1684 {AM o parttick
"Partially added"}
1685 {AD o question
"Added (but now gone)"}
1687 {_D i question
"Missing"}
1688 {DD i removed
"Removed by commit"}
1689 {DO i removed
"Removed (still exists)"}
1690 {DM i removed
"Removed (but modified)"}
1692 {UD i merge
"Merge conflicts"}
1693 {UM i merge
"Merge conflicts"}
1694 {U_ i merge
"Merge conflicts"}
1696 if {$max_status_desc < [string length
[lindex
$i 3]]} {
1697 set max_status_desc
[string length
[lindex
$i 3]]
1699 if {[lindex
$i 1] eq
{i
}} {
1700 set all_cols
([lindex
$i 0]) $ui_index
1702 set all_cols
([lindex
$i 0]) $ui_other
1704 set all_icons
([lindex
$i 0]) file_
[lindex
$i 2]
1705 set all_descs
([lindex
$i 0]) [lindex
$i 3]
1709 ######################################################################
1714 global tcl_platform tk_library
1715 if {$tcl_platform(platform
) eq
{unix
}
1716 && $tcl_platform(os
) eq
{Darwin
}
1717 && [string match
/Library
/Frameworks
/* $tk_library]} {
1723 proc bind_button3
{w cmd
} {
1724 bind $w <Any-Button-3
> $cmd
1726 bind $w <Control-Button-1
> $cmd
1730 proc incr_font_size
{font
{amt
1}} {
1731 set sz
[font configure
$font -size]
1733 font configure
$font -size $sz
1734 font configure
${font}bold
-size $sz
1737 proc hook_failed_popup
{hook msg
} {
1738 global gitdir appname
1744 label
$w.m.l1
-text "$hook hook failed:" \
1749 -background white
-borderwidth 1 \
1751 -width 80 -height 10 \
1753 -yscrollcommand [list
$w.m.sby
set]
1755 -text {You must correct the above errors before committing.
} \
1759 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
1760 pack
$w.m.l1
-side top
-fill x
1761 pack
$w.m.l2
-side bottom
-fill x
1762 pack
$w.m.sby
-side right
-fill y
1763 pack
$w.m.t
-side left
-fill both
-expand 1
1764 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
1766 $w.m.t insert
1.0 $msg
1767 $w.m.t conf
-state disabled
1769 button
$w.ok
-text OK \
1772 -command "destroy $w"
1773 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
1775 bind $w <Visibility
> "grab $w; focus $w"
1776 bind $w <Key-Return
> "destroy $w"
1777 wm title
$w "$appname ([lindex [file split \
1778 [file normalize [file dirname $gitdir]]] \
1783 set next_console_id
0
1785 proc new_console
{short_title long_title
} {
1786 global next_console_id console_data
1787 set w .console
[incr next_console_id
]
1788 set console_data
($w) [list
$short_title $long_title]
1789 return [console_init
$w]
1792 proc console_init
{w
} {
1793 global console_cr console_data
1794 global gitdir appname M1B
1796 set console_cr
($w) 1.0
1799 label
$w.m.l1
-text "[lindex $console_data($w) 1]:" \
1804 -background white
-borderwidth 1 \
1806 -width 80 -height 10 \
1809 -yscrollcommand [list
$w.m.sby
set]
1810 label
$w.m.s
-text {Working... please
wait...
} \
1814 scrollbar
$w.m.sby
-command [list
$w.m.t yview
]
1815 pack
$w.m.l1
-side top
-fill x
1816 pack
$w.m.s
-side bottom
-fill x
1817 pack
$w.m.sby
-side right
-fill y
1818 pack
$w.m.t
-side left
-fill both
-expand 1
1819 pack
$w.m
-side top
-fill both
-expand 1 -padx 5 -pady 10
1821 menu
$w.ctxm
-tearoff 0
1822 $w.ctxm add
command -label "Copy" \
1824 -command "tk_textCopy $w.m.t"
1825 $w.ctxm add
command -label "Select All" \
1827 -command "$w.m.t tag add sel 0.0 end"
1828 $w.ctxm add
command -label "Copy All" \
1831 $w.m.t tag add sel 0.0 end
1833 $w.m.t tag remove sel 0.0 end
1836 button
$w.ok
-text {Close
} \
1839 -command "destroy $w"
1840 pack
$w.ok
-side bottom
-anchor e
-pady 10 -padx 10
1842 bind_button3
$w.m.t
"tk_popup $w.ctxm %X %Y"
1843 bind $w.m.t
<$M1B-Key-a> "$w.m.t tag add sel 0.0 end;break"
1844 bind $w.m.t
<$M1B-Key-A> "$w.m.t tag add sel 0.0 end;break"
1845 bind $w <Visibility
> "focus $w"
1846 wm title
$w "$appname ([lindex [file split \
1847 [file normalize [file dirname $gitdir]]] \
1848 end]): [lindex $console_data($w) 0]"
1852 proc console_exec
{w cmd
{after
{}}} {
1855 # -- Windows tosses the enviroment when we exec our child.
1856 # But most users need that so we have to relogin. :-(
1858 if {$tcl_platform(platform
) eq
{windows
}} {
1859 set cmd
[list sh
--login -c "cd \"[pwd]\" && [join $cmd { }]"]
1862 # -- Tcl won't let us redirect both stdout and stderr to
1863 # the same pipe. So pass it through cat...
1865 set cmd
[concat |
$cmd |
& cat]
1867 set fd_f
[open
$cmd r
]
1868 fconfigure
$fd_f -blocking 0 -translation binary
1869 fileevent
$fd_f readable
[list console_read
$w $fd_f $after]
1872 proc console_read
{w fd after
} {
1873 global console_cr console_data
1877 if {![winfo exists
$w]} {console_init
$w}
1878 $w.m.t conf
-state normal
1880 set n
[string length
$buf]
1882 set cr
[string first
"\r" $buf $c]
1883 set lf
[string first
"\n" $buf $c]
1884 if {$cr < 0} {set cr
[expr {$n + 1}]}
1885 if {$lf < 0} {set lf
[expr {$n + 1}]}
1888 $w.m.t insert end
[string range
$buf $c $lf]
1889 set console_cr
($w) [$w.m.t index
{end
-1c}]
1893 $w.m.t delete
$console_cr($w) end
1894 $w.m.t insert end
"\n"
1895 $w.m.t insert end
[string range
$buf $c $cr]
1900 $w.m.t conf
-state disabled
1904 fconfigure
$fd -blocking 1
1906 if {[catch
{close
$fd}]} {
1907 if {![winfo exists
$w]} {console_init
$w}
1908 $w.m.s conf
-background red
-text {Error
: Command Failed
}
1909 $w.ok conf
-state normal
1911 } elseif
{[winfo exists
$w]} {
1912 $w.m.s conf
-background green
-text {Success
}
1913 $w.ok conf
-state normal
1916 array
unset console_cr
$w
1917 array
unset console_data
$w
1919 uplevel
#0 $after $ok
1923 fconfigure
$fd -blocking 0
1926 ######################################################################
1930 set starting_gitk_msg
{Please
wait... Starting gitk...
}
1933 global tcl_platform ui_status_value starting_gitk_msg
1935 set ui_status_value
$starting_gitk_msg
1937 if {$ui_status_value eq
$starting_gitk_msg} {
1938 set ui_status_value
{Ready.
}
1942 if {$tcl_platform(platform
) eq
{windows
}} {
1950 set w
[new_console
{repack
} \
1951 {Repacking the object database
}]
1952 set cmd
[list git repack
]
1955 console_exec
$w $cmd
1958 proc do_fsck_objects
{} {
1959 set w
[new_console
{fsck-objects
} \
1960 {Verifying the object database with fsck-objects
}]
1961 set cmd
[list git fsck-objects
]
1964 lappend cmd
--strict
1965 console_exec
$w $cmd
1971 global gitdir ui_comm is_quitting repo_config commit_type
1973 if {$is_quitting} return
1976 # -- Stash our current commit buffer.
1978 set save
[file join $gitdir GITGUI_MSG
]
1979 set msg
[string trim
[$ui_comm get
0.0 end
]]
1980 if {![string match amend
* $commit_type]
1981 && [$ui_comm edit modified
]
1984 set fd
[open
$save w
]
1985 puts
$fd [string trim
[$ui_comm get
0.0 end
]]
1989 catch
{file delete
$save}
1992 # -- Stash our current window geometry into this repository.
1994 set cfg_geometry
[list
]
1995 lappend cfg_geometry
[wm geometry .
]
1996 lappend cfg_geometry
[lindex
[.vpane sash coord
0] 1]
1997 lappend cfg_geometry
[lindex
[.vpane.files sash coord
0] 0]
1998 if {[catch
{set rc_geometry
$repo_config(gui.geometry
)}]} {
2001 if {$cfg_geometry ne
$rc_geometry} {
2002 catch
{exec git repo-config gui.geometry
$cfg_geometry}
2009 rescan
{set ui_status_value
{Ready.
}}
2012 proc remove_helper
{txt paths
} {
2013 global file_states current_diff
2015 if {![lock_index begin-update
]} return
2019 foreach path
$paths {
2020 switch
-glob -- [lindex
$file_states($path) 0] {
2024 lappend pathList
$path
2025 if {$path eq
$current_diff} {
2026 set after
{reshow_diff
;}
2031 if {$pathList eq
{}} {
2037 [concat
$after {set ui_status_value
{Ready.
}}]
2041 proc do_remove_selection
{} {
2042 global current_diff selected_paths
2044 if {[array size selected_paths
] > 0} {
2046 {Removing selected files from commit
} \
2047 [array names selected_paths
]
2048 } elseif
{$current_diff ne
{}} {
2050 "Removing [short_path $current_diff] from commit" \
2051 [list
$current_diff]
2055 proc include_helper
{txt paths
} {
2056 global file_states current_diff
2058 if {![lock_index begin-update
]} return
2062 foreach path
$paths {
2063 switch
-glob -- [lindex
$file_states($path) 0] {
2071 lappend pathList
$path
2072 if {$path eq
$current_diff} {
2073 set after
{reshow_diff
;}
2078 if {$pathList eq
{}} {
2084 [concat
$after {set ui_status_value
{Ready to commit.
}}]
2088 proc do_include_selection
{} {
2089 global current_diff selected_paths
2091 if {[array size selected_paths
] > 0} {
2093 {Including selected files
} \
2094 [array names selected_paths
]
2095 } elseif
{$current_diff ne
{}} {
2097 "Including [short_path $current_diff]" \
2098 [list
$current_diff]
2102 proc do_include_all
{} {
2106 foreach path
[array names file_states
] {
2107 switch
-- [lindex
$file_states($path) 0] {
2112 _D
{lappend paths
$path}
2116 {Including all modified files
} \
2120 proc do_signoff
{} {
2123 set me
[committer_ident
]
2124 if {$me eq
{}} return
2126 set sob
"Signed-off-by: $me"
2127 set last
[$ui_comm get
{end
-1c linestart
} {end
-1c}]
2128 if {$last ne
$sob} {
2129 $ui_comm edit separator
2131 && ![regexp
{^
[A-Z
][A-Za-z
]*-[A-Za-z-
]+: *} $last]} {
2132 $ui_comm insert end
"\n"
2134 $ui_comm insert end
"\n$sob"
2135 $ui_comm edit separator
2140 proc do_select_commit_type
{} {
2141 global commit_type selected_commit_type
2143 if {$selected_commit_type eq
{new
}
2144 && [string match amend
* $commit_type]} {
2146 } elseif
{$selected_commit_type eq
{amend
}
2147 && ![string match amend
* $commit_type]} {
2150 # The amend request was rejected...
2152 if {![string match amend
* $commit_type]} {
2153 set selected_commit_type new
2167 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2169 label
$w.header
-text "About $appname" \
2171 pack
$w.header
-side top
-fill x
2174 button
$w.buttons.close
-text {Close
} \
2176 -command [list destroy
$w]
2177 pack
$w.buttons.close
-side right
2178 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2181 -text "$appname - a commit creation tool for Git.
2183 Copyright © 2006 Shawn Pearce, Paul Mackerras
2185 Use and redistribute under the terms of the
2186 GNU General Public License, v. 2.0 or later." \
2193 pack
$w.desc
-side top
-fill x
-padx 5 -pady 5
2196 -text [exec git
--version] \
2203 pack
$w.vers
-side top
-fill x
-padx 5 -pady 5
2205 bind $w <Visibility
> "grab $w; focus $w"
2206 bind $w <Key-Escape
> "destroy $w"
2207 wm title
$w "About $appname"
2211 proc do_options
{} {
2212 global appname gitdir font_descs
2213 global repo_config global_config
2214 global repo_config_new global_config_new
2216 array
unset repo_config_new
2217 array
unset global_config_new
2218 foreach name
[array names repo_config
] {
2219 set repo_config_new
($name) $repo_config($name)
2222 foreach name
[array names repo_config
] {
2224 gui.diffcontext
{continue}
2226 set repo_config_new
($name) $repo_config($name)
2228 foreach name
[array names global_config
] {
2229 set global_config_new
($name) $global_config($name)
2231 set reponame
[lindex
[file split \
2232 [file normalize
[file dirname $gitdir]]] \
2235 set w .options_editor
2237 wm geometry
$w "+[winfo rootx .]+[winfo rooty .]"
2239 label
$w.header
-text "$appname Options" \
2241 pack
$w.header
-side top
-fill x
2244 button
$w.buttons.restore
-text {Restore Defaults
} \
2246 -command do_restore_defaults
2247 pack
$w.buttons.restore
-side left
2248 button
$w.buttons.save
-text Save \
2250 -command [list do_save_config
$w]
2251 pack
$w.buttons.save
-side right
2252 button
$w.buttons.cancel
-text {Cancel
} \
2254 -command [list destroy
$w]
2255 pack
$w.buttons.cancel
-side right
2256 pack
$w.buttons
-side bottom
-fill x
-pady 10 -padx 10
2258 labelframe
$w.repo
-text "$reponame Repository" \
2260 -relief raised
-borderwidth 2
2261 labelframe
$w.global
-text {Global
(All Repositories
)} \
2263 -relief raised
-borderwidth 2
2264 pack
$w.repo
-side left
-fill both
-expand 1 -pady 5 -padx 5
2265 pack
$w.global
-side right
-fill both
-expand 1 -pady 5 -padx 5
2268 {b partialinclude
{Allow Partially Included Files
}}
2269 {b pullsummary
{Show Pull Summary
}}
2270 {b trustmtime
{Trust File Modification Timestamps
}}
2271 {i diffcontext
{Number of Diff Context Lines
}}
2273 set type [lindex
$option 0]
2274 set name
[lindex
$option 1]
2275 set text
[lindex
$option 2]
2276 foreach f
{repo global
} {
2279 checkbutton
$w.
$f.
$name -text $text \
2280 -variable ${f}_config_new
(gui.
$name) \
2284 pack
$w.
$f.
$name -side top
-anchor w
2288 label
$w.
$f.
$name.l
-text "$text:" -font font_ui
2289 pack
$w.
$f.
$name.l
-side left
-anchor w
-fill x
2290 spinbox
$w.
$f.
$name.v \
2291 -textvariable ${f}_config_new
(gui.
$name) \
2292 -from 1 -to 99 -increment 1 \
2295 pack
$w.
$f.
$name.v
-side right
-anchor e
2296 pack
$w.
$f.
$name -side top
-anchor w
-fill x
2302 set all_fonts
[lsort
[font families
]]
2303 foreach option
$font_descs {
2304 set name
[lindex
$option 0]
2305 set font
[lindex
$option 1]
2306 set text
[lindex
$option 2]
2308 set global_config_new
(gui.
$font^^family
) \
2309 [font configure
$font -family]
2310 set global_config_new
(gui.
$font^^size
) \
2311 [font configure
$font -size]
2313 frame
$w.global.
$name
2314 label
$w.global.
$name.l
-text "$text:" -font font_ui
2315 pack
$w.global.
$name.l
-side left
-anchor w
-fill x
2316 eval tk_optionMenu
$w.global.
$name.family \
2317 global_config_new
(gui.
$font^^family
) \
2319 spinbox
$w.global.
$name.size \
2320 -textvariable global_config_new
(gui.
$font^^size
) \
2321 -from 2 -to 80 -increment 1 \
2324 pack
$w.global.
$name.size
-side right
-anchor e
2325 pack
$w.global.
$name.family
-side right
-anchor e
2326 pack
$w.global.
$name -side top
-anchor w
-fill x
2329 bind $w <Visibility
> "grab $w; focus $w"
2330 bind $w <Key-Escape
> "destroy $w"
2331 wm title
$w "$appname ($reponame): Options"
2335 proc do_restore_defaults
{} {
2336 global font_descs default_config repo_config
2337 global repo_config_new global_config_new
2339 foreach name
[array names default_config
] {
2340 set repo_config_new
($name) $default_config($name)
2341 set global_config_new
($name) $default_config($name)
2344 foreach option
$font_descs {
2345 set name
[lindex
$option 0]
2346 set repo_config
(gui.
$name) $default_config(gui.
$name)
2350 foreach option
$font_descs {
2351 set name
[lindex
$option 0]
2352 set font
[lindex
$option 1]
2353 set global_config_new
(gui.
$font^^family
) \
2354 [font configure
$font -family]
2355 set global_config_new
(gui.
$font^^size
) \
2356 [font configure
$font -size]
2360 proc do_save_config
{w
} {
2361 if {[catch
{save_config
} err
]} {
2362 error_popup
"Failed to completely save options:\n\n$err"
2368 proc do_windows_shortcut
{} {
2369 global gitdir appname argv0
2371 set reponame
[lindex
[file split \
2372 [file normalize
[file dirname $gitdir]]] \
2376 set desktop
[exec cygpath \
2384 set fn
[tk_getSaveFile \
2386 -title "$appname ($reponame): Create Desktop Icon" \
2387 -initialdir $desktop \
2388 -initialfile "Git $reponame.bat"]
2392 set sh
[exec cygpath \
2397 set me
[exec cygpath \
2401 set gd
[exec cygpath \
2405 regsub
-all ' $me "'\\''" me
2406 regsub -all ' $gd "'\\''" gd
2407 puts -nonewline $fd "\"$sh\" --login -c \""
2408 puts -nonewline $fd "GIT_DIR='$gd'"
2409 puts -nonewline $fd " '$me'"
2413 error_popup "Cannot write script:\n\n$err"
2418 proc do_macosx_app {} {
2419 global gitdir appname argv0 env
2421 set reponame [lindex [file split \
2422 [file normalize [file dirname $gitdir]]] \
2425 set fn [tk_getSaveFile \
2427 -title "$appname ($reponame): Create Desktop Icon" \
2428 -initialdir [file join $env(HOME) Desktop] \
2429 -initialfile "Git $reponame.app"]
2432 set Contents [file join $fn Contents]
2433 set MacOS [file join $Contents MacOS]
2434 set exe [file join $MacOS git-gui]
2438 set fd [open [file join $Contents Info.plist] w]
2439 puts $fd {<?xml version="1.0" encoding="UTF-8"?>
2440 <!DOCTYPE plist PUBLIC "-//Apple Computer//DTD PLIST 1.0//EN" "http://www.apple.com/DTDs/PropertyList-1.0.dtd">
2441 <plist version="1.0">
2443 <key>CFBundleDevelopmentRegion</key>
2444 <string>English</string>
2445 <key>CFBundleExecutable</key>
2446 <string>git-gui</string>
2447 <key>CFBundleIdentifier</key>
2448 <string>org.spearce.git-gui</string>
2449 <key>CFBundleInfoDictionaryVersion</key>
2450 <string>6.0</string>
2451 <key>CFBundlePackageType</key>
2452 <string>APPL</string>
2453 <key>CFBundleSignature</key>
2454 <string>????</string>
2455 <key>CFBundleVersion</key>
2456 <string>1.0</string>
2457 <key>NSPrincipalClass</key>
2458 <string>NSApplication</string>
2463 set fd [open $exe w]
2464 set gd [file normalize $gitdir]
2465 set ep [file normalize [exec git --exec-path]]
2466 regsub -all ' $gd "'\\''" gd
2467 regsub
-all ' $ep "'\\''" ep
2468 puts $fd "#!/bin/sh"
2469 foreach name
[array names env
] {
2470 if {[string match GIT_
* $name]} {
2471 regsub
-all ' $env($name) "'\\''" v
2472 puts $fd "export $name='$v'"
2475 puts $fd "export PATH
='$ep':\
$PATH"
2476 puts $fd "export GIT_DIR
='$gd'"
2477 puts $fd "exec [file normalize
$argv0]"
2480 file attributes $exe -permissions u+x,g+x,o+x
2482 error_popup "Cannot
write icon
:\n\n$err"
2487 proc toggle_or_diff {w x y} {
2488 global file_states file_lists current_diff ui_index ui_other
2489 global last_clicked selected_paths
2491 set pos [split [$w index @$x,$y] .]
2492 set lno [lindex $pos 0]
2493 set col [lindex $pos 1]
2494 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2500 set last_clicked [list $w $lno]
2501 array unset selected_paths
2502 $ui_index tag remove in_sel 0.0 end
2503 $ui_other tag remove in_sel 0.0 end
2506 if {$current_diff eq $path} {
2507 set after {reshow_diff;}
2511 switch -glob -- [lindex $file_states($path) 0] {
2518 "Removing
[short_path
$path] from commit
" \
2520 [concat $after {set ui_status_value {Ready.}}]
2524 "Including
[short_path
$path]" \
2526 [concat $after {set ui_status_value {Ready.}}]
2530 show_diff $path $w $lno
2534 proc add_one_to_selection {w x y} {
2536 global last_clicked selected_paths
2538 set pos [split [$w index @$x,$y] .]
2539 set lno [lindex $pos 0]
2540 set col [lindex $pos 1]
2541 set path [lindex $file_lists($w) [expr {$lno - 1}]]
2547 set last_clicked [list $w $lno]
2548 if {[catch {set in_sel $selected_paths($path)}]} {
2552 unset selected_paths($path)
2553 $w tag remove in_sel $lno.0 [expr {$lno + 1}].0
2555 set selected_paths($path) 1
2556 $w tag add in_sel $lno.0 [expr {$lno + 1}].0
2560 proc add_range_to_selection {w x y} {
2562 global last_clicked selected_paths
2564 if {[lindex $last_clicked 0] ne $w} {
2565 toggle_or_diff $w $x $y
2569 set pos [split [$w index @$x,$y] .]
2570 set lno [lindex $pos 0]
2571 set lc [lindex $last_clicked 1]
2580 foreach path [lrange $file_lists($w) \
2581 [expr {$begin - 1}] \
2582 [expr {$end - 1}]] {
2583 set selected_paths($path) 1
2585 $w tag add in_sel $begin.0 [expr {$end + 1}].0
2588 ######################################################################
2592 set cursor_ptr arrow
2593 font create font_diff -family Courier -size 10
2597 eval font configure font_ui [font actual [.dummy cget -font]]
2601 font create font_uibold
2602 font create font_diffbold
2606 if {$tcl_platform(platform) eq {windows}} {
2609 } elseif {[is_MacOSX]} {
2614 proc apply_config {} {
2615 global repo_config font_descs
2617 foreach option $font_descs {
2618 set name [lindex $option 0]
2619 set font [lindex $option 1]
2621 foreach {cn cv} $repo_config(gui.$name) {
2622 font configure $font $cn $cv
2625 error_popup "Invalid font specified
in gui.
$name:\n\n$err"
2627 foreach {cn cv} [font configure $font] {
2628 font configure ${font}bold $cn $cv
2630 font configure ${font}bold -weight bold
2634 set default_config(gui.trustmtime) false
2635 set default_config(gui.pullsummary) true
2636 set default_config(gui.partialinclude) false
2637 set default_config(gui.diffcontext) 5
2638 set default_config(gui.fontui) [font configure font_ui]
2639 set default_config(gui.fontdiff) [font configure font_diff]
2641 {fontui font_ui {Main Font}}
2642 {fontdiff font_diff {Diff/Console Font}}
2647 ######################################################################
2653 menu .mbar -tearoff 0
2654 .mbar add cascade -label Repository -menu .mbar.repository
2655 .mbar add cascade -label Edit -menu .mbar.edit
2656 .mbar add cascade -label Commit -menu .mbar.commit
2657 if {!$single_commit} {
2658 .mbar add cascade -label Fetch -menu .mbar.fetch
2659 .mbar add cascade -label Pull -menu .mbar.pull
2660 .mbar add cascade -label Push -menu .mbar.push
2662 .mbar add cascade -label Help -menu .mbar.help
2663 . configure -menu .mbar
2665 # -- Repository Menu
2667 menu .mbar.repository
2668 .mbar.repository add command -label Visualize \
2671 if {!$single_commit} {
2672 .mbar.repository add separator
2674 .mbar.repository add command -label {Repack Database} \
2675 -command do_repack \
2678 .mbar.repository add command -label {Verify Database} \
2679 -command do_fsck_objects \
2682 .mbar.repository add separator
2684 if {$tcl_platform(platform) eq {windows}} {
2685 .mbar.repository add command \
2686 -label {Create Desktop Icon} \
2687 -command do_windows_shortcut \
2689 } elseif {[is_MacOSX]} {
2690 .mbar.repository add command \
2691 -label {Create Desktop Icon} \
2692 -command do_macosx_app \
2696 .mbar.repository add command -label Quit \
2698 -accelerator $M1T-Q \
2704 .mbar.edit add command -label Undo \
2705 -command {catch {[focus] edit undo}} \
2706 -accelerator $M1T-Z \
2708 .mbar.edit add command -label Redo \
2709 -command {catch {[focus] edit redo}} \
2710 -accelerator $M1T-Y \
2712 .mbar.edit add separator
2713 .mbar.edit add command -label Cut \
2714 -command {catch {tk_textCut [focus]}} \
2715 -accelerator $M1T-X \
2717 .mbar.edit add command -label Copy \
2718 -command {catch {tk_textCopy [focus]}} \
2719 -accelerator $M1T-C \
2721 .mbar.edit add command -label Paste \
2722 -command {catch {tk_textPaste [focus]; [focus] see insert}} \
2723 -accelerator $M1T-V \
2725 .mbar.edit add command -label Delete \
2726 -command {catch {[focus] delete sel.first sel.last}} \
2729 .mbar.edit add separator
2730 .mbar.edit add command -label {Select All} \
2731 -command {catch {[focus] tag add sel 0.0 end}} \
2732 -accelerator $M1T-A \
2734 .mbar.edit add separator
2735 .mbar.edit add command -label {Options...} \
2736 -command do_options \
2743 .mbar.commit add radiobutton \
2744 -label {New Commit} \
2745 -command do_select_commit_type \
2746 -variable selected_commit_type \
2749 lappend disable_on_lock \
2750 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2752 .mbar.commit add radiobutton \
2753 -label {Amend Last Commit} \
2754 -command do_select_commit_type \
2755 -variable selected_commit_type \
2758 lappend disable_on_lock \
2759 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2761 .mbar.commit add separator
2763 .mbar.commit add command -label Rescan \
2764 -command do_rescan \
2767 lappend disable_on_lock \
2768 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2770 .mbar.commit add command -label {Remove From Commit} \
2771 -command do_remove_selection \
2773 lappend disable_on_lock \
2774 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2776 .mbar.commit add command -label {Include In Commit} \
2777 -command do_include_selection \
2779 lappend disable_on_lock \
2780 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2782 .mbar.commit add command -label {Include All In Commit} \
2783 -command do_include_all \
2784 -accelerator $M1T-I \
2786 lappend disable_on_lock \
2787 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2789 .mbar.commit add separator
2791 .mbar.commit add command -label {Sign Off} \
2792 -command do_signoff \
2793 -accelerator $M1T-S \
2796 .mbar.commit add command -label Commit \
2797 -command do_commit \
2798 -accelerator $M1T-Return \
2800 lappend disable_on_lock \
2801 [list .mbar.commit entryconf [.mbar.commit index last] -state]
2803 # -- Transport menus
2805 if {!$single_commit} {
2815 .mbar.help add command -label "About
$appname" \
2819 # -- Main Window Layout
2821 panedwindow .vpane -orient vertical
2822 panedwindow .vpane.files -orient horizontal
2823 .vpane add .vpane.files -sticky nsew -height 100 -width 400
2824 pack .vpane -anchor n -side top -fill both -expand 1
2826 # -- Index File List
2828 frame .vpane.files.index -height 100 -width 400
2829 label .vpane.files.index.title -text {Modified Files} \
2832 text $ui_index -background white -borderwidth 0 \
2833 -width 40 -height 10 \
2835 -cursor $cursor_ptr \
2836 -yscrollcommand {.vpane.files.index.sb set} \
2838 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
2839 pack .vpane.files.index.title -side top -fill x
2840 pack .vpane.files.index.sb -side right -fill y
2841 pack $ui_index -side left -fill both -expand 1
2842 .vpane.files add .vpane.files.index -sticky nsew
2844 # -- Other (Add) File List
2846 frame .vpane.files.other -height 100 -width 100
2847 label .vpane.files.other.title -text {Untracked Files} \
2850 text $ui_other -background white -borderwidth 0 \
2851 -width 40 -height 10 \
2853 -cursor $cursor_ptr \
2854 -yscrollcommand {.vpane.files.other.sb set} \
2856 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
2857 pack .vpane.files.other.title -side top -fill x
2858 pack .vpane.files.other.sb -side right -fill y
2859 pack $ui_other -side left -fill both -expand 1
2860 .vpane.files add .vpane.files.other -sticky nsew
2862 foreach i [list $ui_index $ui_other] {
2863 $i tag conf in_diff -font font_uibold
2864 $i tag conf in_sel \
2865 -background [$i cget -foreground] \
2866 -foreground [$i cget -background]
2870 # -- Diff and Commit Area
2872 frame .vpane.lower -height 300 -width 400
2873 frame .vpane.lower.commarea
2874 frame .vpane.lower.diff -relief sunken -borderwidth 1
2875 pack .vpane.lower.commarea -side top -fill x
2876 pack .vpane.lower.diff -side bottom -fill both -expand 1
2877 .vpane add .vpane.lower -stick nsew
2879 # -- Commit Area Buttons
2881 frame .vpane.lower.commarea.buttons
2882 label .vpane.lower.commarea.buttons.l -text {} \
2886 pack .vpane.lower.commarea.buttons.l -side top -fill x
2887 pack .vpane.lower.commarea.buttons -side left -fill y
2889 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
2890 -command do_rescan \
2892 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
2893 lappend disable_on_lock \
2894 {.vpane.lower.commarea.buttons.rescan conf -state}
2896 button .vpane.lower.commarea.buttons.incall -text {Include All} \
2897 -command do_include_all \
2899 pack .vpane.lower.commarea.buttons.incall -side top -fill x
2900 lappend disable_on_lock \
2901 {.vpane.lower.commarea.buttons.incall conf -state}
2903 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
2904 -command do_signoff \
2906 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
2908 button .vpane.lower.commarea.buttons.commit -text {Commit} \
2909 -command do_commit \
2911 pack .vpane.lower.commarea.buttons.commit -side top -fill x
2912 lappend disable_on_lock \
2913 {.vpane.lower.commarea.buttons.commit conf -state}
2915 # -- Commit Message Buffer
2917 frame .vpane.lower.commarea.buffer
2918 frame .vpane.lower.commarea.buffer.header
2919 set ui_comm .vpane.lower.commarea.buffer.t
2920 set ui_coml .vpane.lower.commarea.buffer.header.l
2921 radiobutton .vpane.lower.commarea.buffer.header.new \
2922 -text {New Commit} \
2923 -command do_select_commit_type \
2924 -variable selected_commit_type \
2927 lappend disable_on_lock \
2928 [list .vpane.lower.commarea.buffer.header.new conf -state]
2929 radiobutton .vpane.lower.commarea.buffer.header.amend \
2930 -text {Amend Last Commit} \
2931 -command do_select_commit_type \
2932 -variable selected_commit_type \
2935 lappend disable_on_lock \
2936 [list .vpane.lower.commarea.buffer.header.amend conf -state]
2941 proc trace_commit_type {varname args} {
2942 global ui_coml commit_type
2943 switch -glob -- $commit_type {
2944 initial {set txt {Initial Commit Message:}}
2945 amend {set txt {Amended Commit Message:}}
2946 amend-initial {set txt {Amended Initial Commit Message:}}
2947 amend-merge {set txt {Amended Merge Commit Message:}}
2948 merge {set txt {Merge Commit Message:}}
2949 * {set txt {Commit Message:}}
2951 $ui_coml conf -text $txt
2953 trace add variable commit_type write trace_commit_type
2954 pack $ui_coml -side left -fill x
2955 pack .vpane.lower.commarea.buffer.header.amend -side right
2956 pack .vpane.lower.commarea.buffer.header.new -side right
2958 text $ui_comm -background white -borderwidth 1 \
2961 -autoseparators true \
2963 -width 75 -height 9 -wrap none \
2965 -yscrollcommand {.vpane.lower.commarea.buffer.sby set}
2966 scrollbar .vpane.lower.commarea.buffer.sby \
2967 -command [list $ui_comm yview]
2968 pack .vpane.lower.commarea.buffer.header -side top -fill x
2969 pack .vpane.lower.commarea.buffer.sby -side right -fill y
2970 pack $ui_comm -side left -fill y
2971 pack .vpane.lower.commarea.buffer -side left -fill y
2973 # -- Commit Message Buffer Context Menu
2975 set ctxm .vpane.lower.commarea.buffer.ctxm
2976 menu $ctxm -tearoff 0
2980 -command {tk_textCut $ui_comm}
2984 -command {tk_textCopy $ui_comm}
2988 -command {tk_textPaste $ui_comm}
2992 -command {$ui_comm delete sel.first sel.last}
2995 -label {Select All} \
2997 -command {$ui_comm tag add sel 0.0 end}
3002 $ui_comm tag add sel 0.0 end
3003 tk_textCopy $ui_comm
3004 $ui_comm tag remove sel 0.0 end
3011 bind_button3 $ui_comm "tk_popup
$ctxm %X
%Y
"
3016 set diff_actions [list]
3017 proc trace_current_diff {varname args} {
3018 global current_diff diff_actions file_states
3019 if {$current_diff eq {}} {
3026 set s [mapdesc [lindex $file_states($p) 0] $p]
3028 set p [escape_path $p]
3032 .vpane.lower.diff.header.status configure -text $s
3033 .vpane.lower.diff.header.file configure -text $f
3034 .vpane.lower.diff.header.path configure -text $p
3035 foreach w $diff_actions {
3039 trace add variable current_diff write trace_current_diff
3041 frame .vpane.lower.diff.header -background orange
3042 label .vpane.lower.diff.header.status \
3043 -background orange \
3044 -width $max_status_desc \
3048 label .vpane.lower.diff.header.file \
3049 -background orange \
3053 label .vpane.lower.diff.header.path \
3054 -background orange \
3058 pack .vpane.lower.diff.header.status -side left
3059 pack .vpane.lower.diff.header.file -side left
3060 pack .vpane.lower.diff.header.path -fill x
3061 set ctxm .vpane.lower.diff.header.ctxm
3062 menu $ctxm -tearoff 0
3073 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3074 bind_button3 .vpane.lower.diff.header.path "tk_popup
$ctxm %X
%Y
"
3078 frame .vpane.lower.diff.body
3079 set ui_diff .vpane.lower.diff.body.t
3080 text $ui_diff -background white -borderwidth 0 \
3081 -width 80 -height 15 -wrap none \
3083 -xscrollcommand {.vpane.lower.diff.body.sbx set} \
3084 -yscrollcommand {.vpane.lower.diff.body.sby set} \
3086 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
3087 -command [list $ui_diff xview]
3088 scrollbar .vpane.lower.diff.body.sby -orient vertical \
3089 -command [list $ui_diff yview]
3090 pack .vpane.lower.diff.body.sbx -side bottom -fill x
3091 pack .vpane.lower.diff.body.sby -side right -fill y
3092 pack $ui_diff -side left -fill both -expand 1
3093 pack .vpane.lower.diff.header -side top -fill x
3094 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
3096 $ui_diff tag conf d_@ -font font_diffbold
3097 $ui_diff tag conf d_+ -foreground blue
3098 $ui_diff tag conf d_- -foreground red
3099 $ui_diff tag conf d_++ -foreground {#00a000}
3100 $ui_diff tag conf d_-- -foreground {#a000a0}
3101 $ui_diff tag conf d_+- \
3103 -background {light goldenrod yellow}
3104 $ui_diff tag conf d_-+ \
3108 # -- Diff Body Context Menu
3110 set ctxm .vpane.lower.diff.body.ctxm
3111 menu $ctxm -tearoff 0
3115 -command {tk_textCopy $ui_diff}
3116 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3118 -label {Select All} \
3120 -command {$ui_diff tag add sel 0.0 end}
3121 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3126 $ui_diff tag add sel 0.0 end
3127 tk_textCopy $ui_diff
3128 $ui_diff tag remove sel 0.0 end
3130 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3133 -label {Decrease Font Size} \
3135 -command {incr_font_size font_diff -1}
3136 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3138 -label {Increase Font Size} \
3140 -command {incr_font_size font_diff 1}
3141 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3144 -label {Show Less Context} \
3146 -command {if {$repo_config(gui.diffcontext) >= 2} {
3147 incr repo_config(gui.diffcontext) -1
3150 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3152 -label {Show More Context} \
3155 incr repo_config(gui.diffcontext)
3158 lappend diff_actions [list $ctxm entryconf [$ctxm index last] -state]
3160 $ctxm add command -label {Options...} \
3163 bind_button3 $ui_diff "tk_popup
$ctxm %X
%Y
"
3167 set ui_status_value {Initializing...}
3168 label .status -textvariable ui_status_value \
3174 pack .status -anchor w -side bottom -fill x
3179 set gm $repo_config(gui.geometry)
3180 wm geometry . [lindex $gm 0]
3181 .vpane sash place 0 \
3182 [lindex [.vpane sash coord 0] 0] \
3184 .vpane.files sash place 0 \
3186 [lindex [.vpane.files sash coord 0] 1]
3192 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
3193 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
3194 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
3195 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
3196 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
3197 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
3198 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
3199 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
3200 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
3201 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3202 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3204 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
3205 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
3206 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
3207 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
3208 bind $ui_diff <$M1B-Key-v> {break}
3209 bind $ui_diff <$M1B-Key-V> {break}
3210 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
3211 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
3212 bind $ui_diff <Key-Up> {catch {%W yview scroll -1 units};break}
3213 bind $ui_diff <Key-Down> {catch {%W yview scroll 1 units};break}
3214 bind $ui_diff <Key-Left> {catch {%W xview scroll -1 units};break}
3215 bind $ui_diff <Key-Right> {catch {%W xview scroll 1 units};break}
3217 bind . <Destroy> do_quit
3218 bind all <Key-F5> do_rescan
3219 bind all <$M1B-Key-r> do_rescan
3220 bind all <$M1B-Key-R> do_rescan
3221 bind . <$M1B-Key-s> do_signoff
3222 bind . <$M1B-Key-S> do_signoff
3223 bind . <$M1B-Key-i> do_include_all
3224 bind . <$M1B-Key-I> do_include_all
3225 bind . <$M1B-Key-Return> do_commit
3226 bind all <$M1B-Key-q> do_quit
3227 bind all <$M1B-Key-Q> do_quit
3228 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
3229 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
3230 foreach i [list $ui_index $ui_other] {
3231 bind $i <Button-1> "toggle_or_diff
$i %x
%y
; break"
3232 bind $i <$M1B-Button-1> "add_one_to_selection
$i %x
%y
; break"
3233 bind $i <Shift-Button-1> "add_range_to_selection
$i %x
%y
; break"
3237 set file_lists($ui_index) [list]
3238 set file_lists($ui_other) [list]
3242 set MERGE_HEAD [list]
3246 set selected_commit_type new
3248 wm title . "$appname ([file normalize
[file dirname $gitdir]])"
3249 focus -force $ui_comm
3250 if {!$single_commit} {
3252 populate_fetch_menu .mbar.fetch
3253 populate_pull_menu .mbar.pull
3254 populate_push_menu .mbar.push
3256 lock_index begin-read