Code

git-gui: Always indicate the file in the diff viewer.
[git.git] / git-gui
1 #!/bin/sh
2 # Tcl ignores the next line -*- tcl -*- \
3 exec wish "$0" -- "$@"
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 ######################################################################
11 ##
12 ## config
14 proc load_repo_config {} {
15         global repo_config
16         global cfg_trust_mtime
18         array unset repo_config
19         catch {
20                 set fd_rc [open "| git repo-config --list" r]
21                 while {[gets $fd_rc line] >= 0} {
22                         if {[regexp {^([^=]+)=(.*)$} $line line name value]} {
23                                 lappend repo_config($name) $value
24                         }
25                 }
26                 close $fd_rc
27         }
29         if {[catch {set cfg_trust_mtime \
30                         [lindex $repo_config(gui.trustmtime) 0]
31                 }]} {
32                 set cfg_trust_mtime false
33         }
34 }
36 proc save_my_config {} {
37         global repo_config
38         global cfg_trust_mtime
40         if {[catch {set rc_trustMTime $repo_config(gui.trustmtime)}]} {
41                 set rc_trustMTime [list false]
42         }
43         if {$cfg_trust_mtime != [lindex $rc_trustMTime 0]} {
44                 exec git repo-config gui.trustMTime $cfg_trust_mtime
45                 set repo_config(gui.trustmtime) [list $cfg_trust_mtime]
46         }
48         set cfg_geometry [list \
49                 [wm geometry .] \
50                 [.vpane sash coord 0] \
51                 [.vpane.files sash coord 0] \
52                 ]
53         if {[catch {set rc_geometry $repo_config(gui.geometry)}]} {
54                 set rc_geometry [list [list]]
55         }
56         if {$cfg_geometry != [lindex $rc_geometry 0]} {
57                 exec git repo-config gui.geometry $cfg_geometry
58                 set repo_config(gui.geometry) [list $cfg_geometry]
59         }
60 }
62 ######################################################################
63 ##
64 ## repository setup
66 set appname [lindex [file split $argv0] end]
67 set gitdir {}
68 set GIT_COMMITTER_IDENT {}
70 if {[catch {set cdup [exec git rev-parse --show-cdup]} err]} {
71         show_msg {} . "Cannot find the git directory: $err"
72         exit 1
73 }
74 if {$cdup != ""} {
75         cd $cdup
76 }
77 unset cdup
79 if {[catch {set gitdir [exec git rev-parse --git-dir]} err]} {
80         show_msg {} . "Cannot find the git directory: $err"
81         exit 1
82 }
84 if {$appname == {git-citool}} {
85         set single_commit 1
86 }
88 load_repo_config
90 ######################################################################
91 ##
92 ## task management
94 set single_commit 0
95 set status_active 0
96 set diff_active 0
97 set update_active 0
98 set commit_active 0
99 set update_index_fd {}
101 set disable_on_lock [list]
102 set index_lock_type none
104 set HEAD {}
105 set PARENT {}
106 set commit_type {}
108 proc lock_index {type} {
109         global index_lock_type disable_on_lock
111         if {$index_lock_type == {none}} {
112                 set index_lock_type $type
113                 foreach w $disable_on_lock {
114                         uplevel #0 $w disabled
115                 }
116                 return 1
117         } elseif {$index_lock_type == {begin-update} && $type == {update}} {
118                 set index_lock_type $type
119                 return 1
120         }
121         return 0
124 proc unlock_index {} {
125         global index_lock_type disable_on_lock
127         set index_lock_type none
128         foreach w $disable_on_lock {
129                 uplevel #0 $w normal
130         }
133 ######################################################################
134 ##
135 ## status
137 proc repository_state {hdvar ctvar} {
138         global gitdir
139         upvar $hdvar hd $ctvar ct
141         if {[catch {set hd [exec git rev-parse --verify HEAD]}]} {
142                 set ct initial
143         } elseif {[file exists [file join $gitdir MERGE_HEAD]]} {
144                 set ct merge
145         } else {
146                 set ct normal
147         }
150 proc update_status {{final Ready.}} {
151         global HEAD PARENT commit_type
152         global ui_index ui_other ui_status_value ui_comm
153         global status_active file_states file_lists
154         global cfg_trust_mtime
156         if {$status_active || ![lock_index read]} return
158         repository_state new_HEAD new_type
159         if {$commit_type == {amend} 
160                 && $new_type == {normal}
161                 && $new_HEAD == $HEAD} {
162         } else {
163                 set HEAD $new_HEAD
164                 set PARENT $new_HEAD
165                 set commit_type $new_type
166         }
168         array unset file_states
169         array unset file_lists
170         foreach w [list $ui_index $ui_other] {
171                 $w conf -state normal
172                 $w delete 0.0 end
173                 $w conf -state disabled
174         }
176         if {![$ui_comm edit modified]
177                 || [string trim [$ui_comm get 0.0 end]] == {}} {
178                 if {[load_message GITGUI_MSG]} {
179                 } elseif {[load_message MERGE_MSG]} {
180                 } elseif {[load_message SQUASH_MSG]} {
181                 }
182                 $ui_comm edit modified false
183                 $ui_comm edit reset
184         }
186         if {$cfg_trust_mtime == {true}} {
187                 update_status_stage2 {} $final
188         } else {
189                 set status_active 1
190                 set ui_status_value {Refreshing file status...}
191                 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
192                 fconfigure $fd_rf -blocking 0 -translation binary
193                 fileevent $fd_rf readable [list update_status_stage2 $fd_rf $final]
194         }
197 proc update_status_stage2 {fd final} {
198         global gitdir PARENT commit_type
199         global ui_index ui_other ui_status_value ui_comm
200         global status_active
201         global buf_rdi buf_rdf buf_rlo
203         if {$fd != {}} {
204                 read $fd
205                 if {![eof $fd]} return
206                 close $fd
207         }
209         set ls_others [list | git ls-files --others -z \
210                 --exclude-per-directory=.gitignore]
211         set info_exclude [file join $gitdir info exclude]
212         if {[file readable $info_exclude]} {
213                 lappend ls_others "--exclude-from=$info_exclude"
214         }
216         set buf_rdi {}
217         set buf_rdf {}
218         set buf_rlo {}
220         set status_active 3
221         set ui_status_value {Scanning for modified files ...}
222         set fd_di [open "| git diff-index --cached -z $PARENT" r]
223         set fd_df [open "| git diff-files -z" r]
224         set fd_lo [open $ls_others r]
226         fconfigure $fd_di -blocking 0 -translation binary
227         fconfigure $fd_df -blocking 0 -translation binary
228         fconfigure $fd_lo -blocking 0 -translation binary
229         fileevent $fd_di readable [list read_diff_index $fd_di $final]
230         fileevent $fd_df readable [list read_diff_files $fd_df $final]
231         fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
234 proc load_message {file} {
235         global gitdir ui_comm
237         set f [file join $gitdir $file]
238         if {[file isfile $f]} {
239                 if {[catch {set fd [open $f r]}]} {
240                         return 0
241                 }
242                 set content [string trim [read $fd]]
243                 close $fd
244                 $ui_comm delete 0.0 end
245                 $ui_comm insert end $content
246                 return 1
247         }
248         return 0
251 proc read_diff_index {fd final} {
252         global buf_rdi
254         append buf_rdi [read $fd]
255         set c 0
256         set n [string length $buf_rdi]
257         while {$c < $n} {
258                 set z1 [string first "\0" $buf_rdi $c]
259                 if {$z1 == -1} break
260                 incr z1
261                 set z2 [string first "\0" $buf_rdi $z1]
262                 if {$z2 == -1} break
264                 set c $z2
265                 incr z2 -1
266                 display_file \
267                         [string range $buf_rdi $z1 $z2] \
268                         [string index $buf_rdi [expr $z1 - 2]]_
269                 incr c
270         }
271         if {$c < $n} {
272                 set buf_rdi [string range $buf_rdi $c end]
273         } else {
274                 set buf_rdi {}
275         }
277         status_eof $fd buf_rdi $final
280 proc read_diff_files {fd final} {
281         global buf_rdf
283         append buf_rdf [read $fd]
284         set c 0
285         set n [string length $buf_rdf]
286         while {$c < $n} {
287                 set z1 [string first "\0" $buf_rdf $c]
288                 if {$z1 == -1} break
289                 incr z1
290                 set z2 [string first "\0" $buf_rdf $z1]
291                 if {$z2 == -1} break
293                 set c $z2
294                 incr z2 -1
295                 display_file \
296                         [string range $buf_rdf $z1 $z2] \
297                         _[string index $buf_rdf [expr $z1 - 2]]
298                 incr c
299         }
300         if {$c < $n} {
301                 set buf_rdf [string range $buf_rdf $c end]
302         } else {
303                 set buf_rdf {}
304         }
306         status_eof $fd buf_rdf $final
309 proc read_ls_others {fd final} {
310         global buf_rlo
312         append buf_rlo [read $fd]
313         set pck [split $buf_rlo "\0"]
314         set buf_rlo [lindex $pck end]
315         foreach p [lrange $pck 0 end-1] {
316                 display_file $p _O
317         }
318         status_eof $fd buf_rlo $final
321 proc status_eof {fd buf final} {
322         global status_active $buf
323         global ui_fname_value ui_status_value file_states
325         if {[eof $fd]} {
326                 set $buf {}
327                 close $fd
329                 if {[incr status_active -1] == 0} {
330                         unlock_index
332                         display_all_files
333                         set ui_status_value $final
335                         if {$ui_fname_value != {} && [array names file_states \
336                                 -exact $ui_fname_value] != {}}  {
337                                 show_diff $ui_fname_value
338                         } else {
339                                 clear_diff
340                         }
341                 }
342         }
345 ######################################################################
346 ##
347 ## diff
349 proc clear_diff {} {
350         global ui_diff ui_fname_value ui_fstatus_value ui_index ui_other
352         $ui_diff conf -state normal
353         $ui_diff delete 0.0 end
354         $ui_diff conf -state disabled
356         set ui_fname_value {}
357         set ui_fstatus_value {}
359         $ui_index tag remove in_diff 0.0 end
360         $ui_other tag remove in_diff 0.0 end
363 proc show_diff {path {w {}} {lno {}}} {
364         global file_states file_lists
365         global PARENT diff_3way diff_active
366         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
368         if {$diff_active || ![lock_index read]} return
370         clear_diff
371         if {$w == {} || $lno == {}} {
372                 foreach w [array names file_lists] {
373                         set lno [lsearch -sorted $file_lists($w) $path]
374                         if {$lno >= 0} {
375                                 incr lno
376                                 break
377                         }
378                 }
379         }
380         if {$w != {} && $lno >= 1} {
381                 $w tag add in_diff $lno.0 [expr $lno + 1].0
382         }
384         set s $file_states($path)
385         set m [lindex $s 0]
386         set diff_3way 0
387         set diff_active 1
388         set ui_fname_value $path
389         set ui_fstatus_value [mapdesc $m $path]
390         set ui_status_value "Loading diff of $path..."
392         set cmd [list | git diff-index -p $PARENT -- $path]
393         switch $m {
394         AM {
395         }
396         MM {
397                 set cmd [list | git diff-index -p -c $PARENT $path]
398         }
399         _O {
400                 if {[catch {
401                                 set fd [open $path r]
402                                 set content [read $fd]
403                                 close $fd
404                         } err ]} {
405                         set diff_active 0
406                         unlock_index
407                         set ui_status_value "Unable to display $path"
408                         error_popup "Error loading file:\n$err"
409                         return
410                 }
411                 $ui_diff conf -state normal
412                 $ui_diff insert end $content
413                 $ui_diff conf -state disabled
414                 set diff_active 0
415                 unlock_index
416                 set ui_status_value {Ready.}
417                 return
418         }
419         }
421         if {[catch {set fd [open $cmd r]} err]} {
422                 set diff_active 0
423                 unlock_index
424                 set ui_status_value "Unable to display $path"
425                 error_popup "Error loading diff:\n$err"
426                 return
427         }
429         fconfigure $fd -blocking 0 -translation auto
430         fileevent $fd readable [list read_diff $fd]
433 proc read_diff {fd} {
434         global ui_diff ui_status_value diff_3way diff_active
436         while {[gets $fd line] >= 0} {
437                 if {[string match {diff --git *} $line]} continue
438                 if {[string match {diff --combined *} $line]} continue
439                 if {[string match {--- *} $line]} continue
440                 if {[string match {+++ *} $line]} continue
441                 if {[string match index* $line]} {
442                         if {[string first , $line] >= 0} {
443                                 set diff_3way 1
444                         }
445                 }
447                 $ui_diff conf -state normal
448                 if {!$diff_3way} {
449                         set x [string index $line 0]
450                         switch -- $x {
451                         "@" {set tags da}
452                         "+" {set tags dp}
453                         "-" {set tags dm}
454                         default {set tags {}}
455                         }
456                 } else {
457                         set x [string range $line 0 1]
458                         switch -- $x {
459                         default {set tags {}}
460                         "@@" {set tags da}
461                         "++" {set tags dp; set x " +"}
462                         " +" {set tags {di bold}; set x "++"}
463                         "+ " {set tags dni; set x "-+"}
464                         "--" {set tags dm; set x " -"}
465                         " -" {set tags {dm bold}; set x "--"}
466                         "- " {set tags di; set x "+-"}
467                         default {set tags {}}
468                         }
469                         set line [string replace $line 0 1 $x]
470                 }
471                 $ui_diff insert end $line $tags
472                 $ui_diff insert end "\n"
473                 $ui_diff conf -state disabled
474         }
476         if {[eof $fd]} {
477                 close $fd
478                 set diff_active 0
479                 unlock_index
480                 set ui_status_value {Ready.}
481         }
484 ######################################################################
485 ##
486 ## commit
488 proc load_last_commit {} {
489         global HEAD PARENT commit_type ui_comm
491         if {$commit_type == {amend}} return
492         if {$commit_type != {normal}} {
493                 error_popup "Can't amend a $commit_type commit."
494                 return
495         }
497         set msg {}
498         set parent {}
499         set parent_count 0
500         if {[catch {
501                         set fd [open "| git cat-file commit $HEAD" r]
502                         while {[gets $fd line] > 0} {
503                                 if {[string match {parent *} $line]} {
504                                         set parent [string range $line 7 end]
505                                         incr parent_count
506                                 }
507                         }
508                         set msg [string trim [read $fd]]
509                         close $fd
510                 } err]} {
511                 error_popup "Error loading commit data for amend:\n$err"
512                 return
513         }
515         if {$parent_count == 0} {
516                 set commit_type amend
517                 set HEAD {}
518                 set PARENT {}
519                 update_status
520         } elseif {$parent_count == 1} {
521                 set commit_type amend
522                 set PARENT $parent
523                 $ui_comm delete 0.0 end
524                 $ui_comm insert end $msg
525                 $ui_comm edit modified false
526                 $ui_comm edit reset
527                 update_status
528         } else {
529                 error_popup {You can't amend a merge commit.}
530                 return
531         }
534 proc commit_tree {} {
535         global tcl_platform HEAD gitdir commit_type file_states
536         global commit_active ui_status_value
537         global ui_comm
539         if {$commit_active || ![lock_index update]} return
541         # -- Our in memory state should match the repository.
542         #
543         repository_state curHEAD cur_type
544         if {$commit_type == {amend} 
545                 && $cur_type == {normal}
546                 && $curHEAD == $HEAD} {
547         } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
548                 error_popup {Last scanned state does not match repository state.
550 Its highly likely that another Git program modified the
551 repository since our last scan.  A rescan is required
552 before committing.
554                 unlock_index
555                 update_status
556                 return
557         }
559         # -- At least one file should differ in the index.
560         #
561         set files_ready 0
562         foreach path [array names file_states] {
563                 set s $file_states($path)
564                 switch -glob -- [lindex $s 0] {
565                 _* {continue}
566                 A* -
567                 D* -
568                 M* {set files_ready 1; break}
569                 U* {
570                         error_popup "Unmerged files cannot be committed.
572 File $path has merge conflicts.
573 You must resolve them and include the file before committing.
575                         unlock_index
576                         return
577                 }
578                 default {
579                         error_popup "Unknown file state [lindex $s 0] detected.
581 File $path cannot be committed by this program.
583                 }
584                 }
585         }
586         if {!$files_ready} {
587                 error_popup {No included files to commit.
589 You must include at least 1 file before you can commit.
591                 unlock_index
592                 return
593         }
595         # -- A message is required.
596         #
597         set msg [string trim [$ui_comm get 1.0 end]]
598         if {$msg == {}} {
599                 error_popup {Please supply a commit message.
601 A good commit message has the following format:
603 - First line: Describe in one sentance what you did.
604 - Second line: Blank
605 - Remaining lines: Describe why this change is good.
607                 unlock_index
608                 return
609         }
611         # -- Ask the pre-commit hook for the go-ahead.
612         #
613         set pchook [file join $gitdir hooks pre-commit]
614         if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
615                 set pchook [list sh -c \
616                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
617         } elseif {[file executable $pchook]} {
618                 set pchook [list $pchook]
619         } else {
620                 set pchook {}
621         }
622         if {$pchook != {} && [catch {eval exec $pchook} err]} {
623                 hook_failed_popup pre-commit $err
624                 unlock_index
625                 return
626         }
628         # -- Write the tree in the background.
629         #
630         set commit_active 1
631         set ui_status_value {Committing changes...}
633         set fd_wt [open "| git write-tree" r]
634         fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
637 proc commit_stage2 {fd_wt curHEAD msg} {
638         global single_commit gitdir PARENT commit_type
639         global commit_active ui_status_value ui_comm
641         gets $fd_wt tree_id
642         close $fd_wt
644         if {$tree_id == {}} {
645                 error_popup "write-tree failed"
646                 set commit_active 0
647                 set ui_status_value {Commit failed.}
648                 unlock_index
649                 return
650         }
652         # -- Create the commit.
653         #
654         set cmd [list git commit-tree $tree_id]
655         if {$PARENT != {}} {
656                 lappend cmd -p $PARENT
657         }
658         if {$commit_type == {merge}} {
659                 if {[catch {
660                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
661                                 while {[gets $fd_mh merge_head] >= 0} {
662                                         lappend cmd -p $merge_head
663                                 }
664                                 close $fd_mh
665                         } err]} {
666                         error_popup "Loading MERGE_HEADs failed:\n$err"
667                         set commit_active 0
668                         set ui_status_value {Commit failed.}
669                         unlock_index
670                         return
671                 }
672         }
673         if {$PARENT == {}} {
674                 # git commit-tree writes to stderr during initial commit.
675                 lappend cmd 2>/dev/null
676         }
677         lappend cmd << $msg
678         if {[catch {set cmt_id [eval exec $cmd]} err]} {
679                 error_popup "commit-tree failed:\n$err"
680                 set commit_active 0
681                 set ui_status_value {Commit failed.}
682                 unlock_index
683                 return
684         }
686         # -- Update the HEAD ref.
687         #
688         set reflogm commit
689         if {$commit_type != {normal}} {
690                 append reflogm " ($commit_type)"
691         }
692         set i [string first "\n" $msg]
693         if {$i >= 0} {
694                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
695         } else {
696                 append reflogm {: } $msg
697         }
698         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
699         if {[catch {eval exec $cmd} err]} {
700                 error_popup "update-ref failed:\n$err"
701                 set commit_active 0
702                 set ui_status_value {Commit failed.}
703                 unlock_index
704                 return
705         }
707         # -- Cleanup after ourselves.
708         #
709         catch {file delete [file join $gitdir MERGE_HEAD]}
710         catch {file delete [file join $gitdir MERGE_MSG]}
711         catch {file delete [file join $gitdir SQUASH_MSG]}
712         catch {file delete [file join $gitdir GITGUI_MSG]}
714         # -- Let rerere do its thing.
715         #
716         if {[file isdirectory [file join $gitdir rr-cache]]} {
717                 catch {exec git rerere}
718         }
720         $ui_comm delete 0.0 end
721         $ui_comm edit modified false
722         $ui_comm edit reset
724         if {$single_commit} do_quit
726         set commit_type {}
727         set commit_active 0
728         set HEAD $cmt_id
729         set PARENT $cmt_id
730         unlock_index
731         update_status "Changes committed as [string range $cmt_id 0 7]."
734 ######################################################################
735 ##
736 ## fetch pull push
738 proc fetch_from {remote} {
739         set w [new_console "fetch $remote" \
740                 "Fetching new changes from $remote"]
741         set cmd [list git fetch]
742         lappend cmd $remote
743         console_exec $w $cmd
746 proc pull_remote {remote branch} {
747         global HEAD commit_type
748         global file_states
750         if {![lock_index update]} return
752         # -- Our in memory state should match the repository.
753         #
754         repository_state curHEAD cur_type
755         if {$commit_type != $cur_type || $HEAD != $curHEAD} {
756                 error_popup {Last scanned state does not match repository state.
758 Its highly likely that another Git program modified the
759 repository since our last scan.  A rescan is required
760 before a pull can be started.
762                 unlock_index
763                 update_status
764                 return
765         }
767         # -- No differences should exist before a pull.
768         #
769         if {[array size file_states] != 0} {
770                 error_popup {Uncommitted but modified files are present.
772 You should not perform a pull with unmodified files in your working
773 directory as Git would be unable to recover from an incorrect merge.
775 Commit or throw away all changes before starting a pull operation.
777                 unlock_index
778                 return
779         }
781         set w [new_console "pull $remote $branch" \
782                 "Pulling new changes from branch $branch in $remote"]
783         set cmd [list git pull]
784         lappend cmd $remote
785         lappend cmd $branch
786         console_exec $w $cmd [list post_pull_remote $remote $branch]
789 proc post_pull_remote {remote branch success} {
790         global HEAD PARENT commit_type
791         global ui_status_value
793         unlock_index
794         if {$success} {
795                 repository_state HEAD commit_type
796                 set PARENT $HEAD
797                 set $ui_status_value {Ready.}
798         } else {
799                 update_status "Conflicts detected while pulling $branch from $remote."
800         }
803 proc push_to {remote} {
804         set w [new_console "push $remote" \
805                 "Pushing changes to $remote"]
806         set cmd [list git push]
807         lappend cmd $remote
808         console_exec $w $cmd
811 ######################################################################
812 ##
813 ## ui helpers
815 proc mapcol {state path} {
816         global all_cols ui_other
818         if {[catch {set r $all_cols($state)}]} {
819                 puts "error: no column for state={$state} $path"
820                 return $ui_other
821         }
822         return $r
825 proc mapicon {state path} {
826         global all_icons
828         if {[catch {set r $all_icons($state)}]} {
829                 puts "error: no icon for state={$state} $path"
830                 return file_plain
831         }
832         return $r
835 proc mapdesc {state path} {
836         global all_descs
838         if {[catch {set r $all_descs($state)}]} {
839                 puts "error: no desc for state={$state} $path"
840                 return $state
841         }
842         return $r
845 set next_icon_id 0
847 proc merge_state {path new_state} {
848         global file_states next_icon_id
850         set s0 [string index $new_state 0]
851         set s1 [string index $new_state 1]
853         if {[catch {set info $file_states($path)}]} {
854                 set state __
855                 set icon n[incr next_icon_id]
856         } else {
857                 set state [lindex $info 0]
858                 set icon [lindex $info 1]
859         }
861         if {$s0 == {_}} {
862                 set s0 [string index $state 0]
863         } elseif {$s0 == {*}} {
864                 set s0 _
865         }
867         if {$s1 == {_}} {
868                 set s1 [string index $state 1]
869         } elseif {$s1 == {*}} {
870                 set s1 _
871         }
873         set file_states($path) [list $s0$s1 $icon]
874         return $state
877 proc display_file {path state} {
878         global ui_index ui_other
879         global file_states file_lists status_active
881         set old_m [merge_state $path $state]
882         if {$status_active} return
884         set s $file_states($path)
885         set new_m [lindex $s 0]
886         set new_w [mapcol $new_m $path] 
887         set old_w [mapcol $old_m $path]
888         set new_icon [mapicon $new_m $path]
890         if {$new_w != $old_w} {
891                 set lno [lsearch -sorted $file_lists($old_w) $path]
892                 if {$lno >= 0} {
893                         incr lno
894                         $old_w conf -state normal
895                         $old_w delete $lno.0 [expr $lno + 1].0
896                         $old_w conf -state disabled
897                 }
899                 lappend file_lists($new_w) $path
900                 set file_lists($new_w) [lsort $file_lists($new_w)]
901                 set lno [lsearch -sorted $file_lists($new_w) $path]
902                 incr lno
903                 $new_w conf -state normal
904                 $new_w image create $lno.0 \
905                         -align center -padx 5 -pady 1 \
906                         -name [lindex $s 1] \
907                         -image $new_icon
908                 $new_w insert $lno.1 "$path\n"
909                 $new_w conf -state disabled
910         } elseif {$new_icon != [mapicon $old_m $path]} {
911                 $new_w conf -state normal
912                 $new_w image conf [lindex $s 1] -image $new_icon
913                 $new_w conf -state disabled
914         }
917 proc display_all_files {} {
918         global ui_index ui_other file_states file_lists
920         $ui_index conf -state normal
921         $ui_other conf -state normal
923         foreach path [lsort [array names file_states]] {
924                 set s $file_states($path)
925                 set m [lindex $s 0]
926                 set w [mapcol $m $path]
927                 lappend file_lists($w) $path
928                 $w image create end \
929                         -align center -padx 5 -pady 1 \
930                         -name [lindex $s 1] \
931                         -image [mapicon $m $path]
932                 $w insert end "$path\n"
933         }
935         $ui_index conf -state disabled
936         $ui_other conf -state disabled
939 proc with_update_index {body} {
940         global update_index_fd
942         if {$update_index_fd == {}} {
943                 if {![lock_index update]} return
944                 set update_index_fd [open \
945                         "| git update-index --add --remove -z --stdin" \
946                         w]
947                 fconfigure $update_index_fd -translation binary
948                 uplevel 1 $body
949                 close $update_index_fd
950                 set update_index_fd {}
951                 unlock_index
952         } else {
953                 uplevel 1 $body
954         }
957 proc update_index {path} {
958         global update_index_fd
960         if {$update_index_fd == {}} {
961                 error {not in with_update_index}
962         } else {
963                 puts -nonewline $update_index_fd "$path\0"
964         }
967 proc toggle_mode {path} {
968         global file_states ui_fname_value
970         set s $file_states($path)
971         set m [lindex $s 0]
973         switch -- $m {
974         AM -
975         _O {set new A*}
976         _M -
977         MM {set new M*}
978         AD -
979         _D {set new D*}
980         default {return}
981         }
983         with_update_index {update_index $path}
984         display_file $path $new
985         if {$ui_fname_value == $path} {
986                 show_diff $path
987         }
990 ######################################################################
991 ##
992 ## remote management
994 proc load_all_remotes {} {
995         global gitdir all_remotes repo_config
997         set all_remotes [list]
998         set rm_dir [file join $gitdir remotes]
999         if {[file isdirectory $rm_dir]} {
1000                 set all_remotes [concat $all_remotes [glob \
1001                         -types f \
1002                         -tails \
1003                         -nocomplain \
1004                         -directory $rm_dir *]]
1005         }
1007         foreach line [array names repo_config remote.*.url] {
1008                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1009                         lappend all_remotes $name
1010                 }
1011         }
1013         set all_remotes [lsort -unique $all_remotes]
1016 proc populate_remote_menu {m pfx op} {
1017         global all_remotes mainfont
1019         foreach remote $all_remotes {
1020                 $m add command -label "$pfx $remote..." \
1021                         -command [list $op $remote] \
1022                         -font $mainfont
1023         }
1026 proc populate_pull_menu {m} {
1027         global gitdir repo_config all_remotes mainfont disable_on_lock
1029         foreach remote $all_remotes {
1030                 set rb {}
1031                 if {[array get repo_config remote.$remote.url] != {}} {
1032                         if {[array get repo_config remote.$remote.fetch] != {}} {
1033                                 regexp {^([^:]+):} \
1034                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1035                                         line rb
1036                         }
1037                 } else {
1038                         catch {
1039                                 set fd [open [file join $gitdir remotes $remote] r]
1040                                 while {[gets $fd line] >= 0} {
1041                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1042                                                 break
1043                                         }
1044                                 }
1045                                 close $fd
1046                         }
1047                 }
1049                 set rb_short $rb
1050                 regsub ^refs/heads/ $rb {} rb_short
1051                 if {$rb_short != {}} {
1052                         $m add command \
1053                                 -label "Branch $rb_short from $remote..." \
1054                                 -command [list pull_remote $remote $rb] \
1055                                 -font $mainfont
1056                         lappend disable_on_lock \
1057                                 [list $m entryconf [$m index last] -state]
1058                 }
1059         }
1062 ######################################################################
1063 ##
1064 ## icons
1066 set filemask {
1067 #define mask_width 14
1068 #define mask_height 15
1069 static unsigned char mask_bits[] = {
1070    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1071    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1072    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1075 image create bitmap file_plain -background white -foreground black -data {
1076 #define plain_width 14
1077 #define plain_height 15
1078 static unsigned char plain_bits[] = {
1079    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1080    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1081    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1082 } -maskdata $filemask
1084 image create bitmap file_mod -background white -foreground blue -data {
1085 #define mod_width 14
1086 #define mod_height 15
1087 static unsigned char mod_bits[] = {
1088    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1089    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1090    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1091 } -maskdata $filemask
1093 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1094 #define file_fulltick_width 14
1095 #define file_fulltick_height 15
1096 static unsigned char file_fulltick_bits[] = {
1097    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1098    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1099    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1100 } -maskdata $filemask
1102 image create bitmap file_parttick -background white -foreground "#005050" -data {
1103 #define parttick_width 14
1104 #define parttick_height 15
1105 static unsigned char parttick_bits[] = {
1106    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1107    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1108    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1109 } -maskdata $filemask
1111 image create bitmap file_question -background white -foreground black -data {
1112 #define file_question_width 14
1113 #define file_question_height 15
1114 static unsigned char file_question_bits[] = {
1115    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1116    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1117    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1118 } -maskdata $filemask
1120 image create bitmap file_removed -background white -foreground red -data {
1121 #define file_removed_width 14
1122 #define file_removed_height 15
1123 static unsigned char file_removed_bits[] = {
1124    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1125    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1126    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1127 } -maskdata $filemask
1129 image create bitmap file_merge -background white -foreground blue -data {
1130 #define file_merge_width 14
1131 #define file_merge_height 15
1132 static unsigned char file_merge_bits[] = {
1133    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1134    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1135    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1136 } -maskdata $filemask
1138 set ui_index .vpane.files.index.list
1139 set ui_other .vpane.files.other.list
1140 set max_status_desc 0
1141 foreach i {
1142                 {__ i plain    "Unmodified"}
1143                 {_M i mod      "Modified"}
1144                 {M_ i fulltick "Checked in"}
1145                 {MM i parttick "Partially included"}
1147                 {_O o plain    "Untracked"}
1148                 {A_ o fulltick "Added"}
1149                 {AM o parttick "Partially added"}
1150                 {AD o question "Added (but now gone)"}
1152                 {_D i question "Missing"}
1153                 {D_ i removed  "Removed"}
1154                 {DD i removed  "Removed"}
1155                 {DO i removed  "Removed (still exists)"}
1157                 {UM i merge    "Merge conflicts"}
1158                 {U_ i merge    "Merge conflicts"}
1159         } {
1160         if {$max_status_desc < [string length [lindex $i 3]]} {
1161                 set max_status_desc [string length [lindex $i 3]]
1162         }
1163         if {[lindex $i 1] == {i}} {
1164                 set all_cols([lindex $i 0]) $ui_index
1165         } else {
1166                 set all_cols([lindex $i 0]) $ui_other
1167         }
1168         set all_icons([lindex $i 0]) file_[lindex $i 2]
1169         set all_descs([lindex $i 0]) [lindex $i 3]
1171 unset filemask i
1173 ######################################################################
1174 ##
1175 ## util
1177 proc error_popup {msg} {
1178         set w .error
1179         toplevel $w
1180         wm transient $w .
1181         show_msg $w $w $msg
1184 proc show_msg {w top msg} {
1185         global gitdir appname mainfont
1187         message $w.m -text $msg -justify left -aspect 400
1188         pack $w.m -side top -fill x -padx 5 -pady 10
1189         button $w.ok -text OK \
1190                 -width 15 \
1191                 -font $mainfont \
1192                 -command "destroy $top"
1193         pack $w.ok -side bottom
1194         bind $top <Visibility> "grab $top; focus $top"
1195         bind $top <Key-Return> "destroy $top"
1196         wm title $w "$appname ([lindex [file split \
1197                 [file normalize [file dirname $gitdir]]] \
1198                 end]): error"
1199         tkwait window $top
1202 proc hook_failed_popup {hook msg} {
1203         global gitdir mainfont difffont appname
1205         set w .hookfail
1206         toplevel $w
1207         wm transient $w .
1209         frame $w.m
1210         label $w.m.l1 -text "$hook hook failed:" \
1211                 -anchor w \
1212                 -justify left \
1213                 -font [concat $mainfont bold]
1214         text $w.m.t \
1215                 -background white -borderwidth 1 \
1216                 -relief sunken \
1217                 -width 80 -height 10 \
1218                 -font $difffont \
1219                 -yscrollcommand [list $w.m.sby set]
1220         label $w.m.l2 \
1221                 -text {You must correct the above errors before committing.} \
1222                 -anchor w \
1223                 -justify left \
1224                 -font [concat $mainfont bold]
1225         scrollbar $w.m.sby -command [list $w.m.t yview]
1226         pack $w.m.l1 -side top -fill x
1227         pack $w.m.l2 -side bottom -fill x
1228         pack $w.m.sby -side right -fill y
1229         pack $w.m.t -side left -fill both -expand 1
1230         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1232         $w.m.t insert 1.0 $msg
1233         $w.m.t conf -state disabled
1235         button $w.ok -text OK \
1236                 -width 15 \
1237                 -font $mainfont \
1238                 -command "destroy $w"
1239         pack $w.ok -side bottom
1241         bind $w <Visibility> "grab $w; focus $w"
1242         bind $w <Key-Return> "destroy $w"
1243         wm title $w "$appname ([lindex [file split \
1244                 [file normalize [file dirname $gitdir]]] \
1245                 end]): error"
1246         tkwait window $w
1249 set next_console_id 0
1251 proc new_console {short_title long_title} {
1252         global next_console_id console_data
1253         set w .console[incr next_console_id]
1254         set console_data($w) [list $short_title $long_title]
1255         return [console_init $w]
1258 proc console_init {w} {
1259         global console_cr console_data
1260         global gitdir appname mainfont difffont
1262         set console_cr($w) 1.0
1263         toplevel $w
1264         frame $w.m
1265         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1266                 -anchor w \
1267                 -justify left \
1268                 -font [concat $mainfont bold]
1269         text $w.m.t \
1270                 -background white -borderwidth 1 \
1271                 -relief sunken \
1272                 -width 80 -height 10 \
1273                 -font $difffont \
1274                 -state disabled \
1275                 -yscrollcommand [list $w.m.sby set]
1276         label $w.m.s -anchor w \
1277                 -justify left \
1278                 -font [concat $mainfont bold]
1279         scrollbar $w.m.sby -command [list $w.m.t yview]
1280         pack $w.m.l1 -side top -fill x
1281         pack $w.m.s -side bottom -fill x
1282         pack $w.m.sby -side right -fill y
1283         pack $w.m.t -side left -fill both -expand 1
1284         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1286         button $w.ok -text {Running...} \
1287                 -width 15 \
1288                 -font $mainfont \
1289                 -state disabled \
1290                 -command "destroy $w"
1291         pack $w.ok -side bottom
1293         bind $w <Visibility> "focus $w"
1294         wm title $w "$appname ([lindex [file split \
1295                 [file normalize [file dirname $gitdir]]] \
1296                 end]): [lindex $console_data($w) 0]"
1297         return $w
1300 proc console_exec {w cmd {after {}}} {
1301         global tcl_platform
1303         # -- Windows tosses the enviroment when we exec our child.
1304         #    But most users need that so we have to relogin. :-(
1305         #
1306         if {$tcl_platform(platform) == {windows}} {
1307                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1308         }
1310         # -- Tcl won't let us redirect both stdout and stderr to
1311         #    the same pipe.  So pass it through cat...
1312         #
1313         set cmd [concat | $cmd |& cat]
1315         set fd_f [open $cmd r]
1316         fconfigure $fd_f -blocking 0 -translation binary
1317         fileevent $fd_f readable [list console_read $w $fd_f $after]
1320 proc console_read {w fd after} {
1321         global console_cr console_data
1323         set buf [read $fd]
1324         if {$buf != {}} {
1325                 if {![winfo exists $w]} {console_init $w}
1326                 $w.m.t conf -state normal
1327                 set c 0
1328                 set n [string length $buf]
1329                 while {$c < $n} {
1330                         set cr [string first "\r" $buf $c]
1331                         set lf [string first "\n" $buf $c]
1332                         if {$cr < 0} {set cr [expr $n + 1]}
1333                         if {$lf < 0} {set lf [expr $n + 1]}
1335                         if {$lf < $cr} {
1336                                 $w.m.t insert end [string range $buf $c $lf]
1337                                 set console_cr($w) [$w.m.t index {end -1c}]
1338                                 set c $lf
1339                                 incr c
1340                         } else {
1341                                 $w.m.t delete $console_cr($w) end
1342                                 $w.m.t insert end "\n"
1343                                 $w.m.t insert end [string range $buf $c $cr]
1344                                 set c $cr
1345                                 incr c
1346                         }
1347                 }
1348                 $w.m.t conf -state disabled
1349                 $w.m.t see end
1350         }
1352         fconfigure $fd -blocking 1
1353         if {[eof $fd]} {
1354                 if {[catch {close $fd}]} {
1355                         if {![winfo exists $w]} {console_init $w}
1356                         $w.m.s conf -background red -text {Error: Command Failed}
1357                         $w.ok conf -text Close
1358                         $w.ok conf -state normal
1359                         set ok 0
1360                 } elseif {[winfo exists $w]} {
1361                         $w.m.s conf -background green -text {Success}
1362                         $w.ok conf -text Close
1363                         $w.ok conf -state normal
1364                         set ok 1
1365                 }
1366                 array unset console_cr $w
1367                 array unset console_data $w
1368                 if {$after != {}} {
1369                         uplevel #0 $after $ok
1370                 }
1371                 return
1372         }
1373         fconfigure $fd -blocking 0
1376 ######################################################################
1377 ##
1378 ## ui commands
1380 set starting_gitk_msg {Please wait... Starting gitk...}
1382 proc do_gitk {} {
1383         global tcl_platform ui_status_value starting_gitk_msg
1385         set ui_status_value $starting_gitk_msg
1386         after 10000 {
1387                 if {$ui_status_value == $starting_gitk_msg} {
1388                         set ui_status_value {Ready.}
1389                 }
1390         }
1392         if {$tcl_platform(platform) == {windows}} {
1393                 exec sh -c gitk &
1394         } else {
1395                 exec gitk &
1396         }
1399 proc do_repack {} {
1400         set w [new_console "repack" "Repacking the object database"]
1401         set cmd [list git repack]
1402         lappend cmd -a
1403         lappend cmd -d
1404         console_exec $w $cmd
1407 proc do_quit {} {
1408         global gitdir ui_comm
1410         set save [file join $gitdir GITGUI_MSG]
1411         set msg [string trim [$ui_comm get 0.0 end]]
1412         if {[$ui_comm edit modified] && $msg != {}} {
1413                 catch {
1414                         set fd [open $save w]
1415                         puts $fd [string trim [$ui_comm get 0.0 end]]
1416                         close $fd
1417                 }
1418         } elseif {$msg == {} && [file exists $save]} {
1419                 file delete $save
1420         }
1422         save_my_config
1423         destroy .
1426 proc do_rescan {} {
1427         update_status
1430 proc do_include_all {} {
1431         global update_active ui_status_value
1433         if {$update_active || ![lock_index begin-update]} return
1435         set update_active 1
1436         set ui_status_value {Including all modified files...}
1437         after 1 {
1438                 with_update_index {
1439                         foreach path [array names file_states] {
1440                                 set s $file_states($path)
1441                                 set m [lindex $s 0]
1442                                 switch -- $m {
1443                                 AM -
1444                                 MM -
1445                                 _M -
1446                                 _D {toggle_mode $path}
1447                                 }
1448                         }
1449                 }
1450                 set update_active 0
1451                 set ui_status_value {Ready.}
1452         }
1455 proc do_signoff {} {
1456         global ui_comm GIT_COMMITTER_IDENT
1458         if {$GIT_COMMITTER_IDENT == {}} {
1459                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1460                         error_popup "Unable to obtain your identity:\n$err"
1461                         return
1462                 }
1463                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1464                         $me me GIT_COMMITTER_IDENT]} {
1465                         error_popup "Invalid GIT_COMMITTER_IDENT:\n$me"
1466                         return
1467                 }
1468         }
1470         set str "Signed-off-by: $GIT_COMMITTER_IDENT"
1471         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1472                 $ui_comm edit separator
1473                 $ui_comm insert end "\n$str"
1474                 $ui_comm edit separator
1475                 $ui_comm see end
1476         }
1479 proc do_amend_last {} {
1480         load_last_commit
1483 proc do_commit {} {
1484         commit_tree
1487 # shift == 1: left click
1488 #          3: right click  
1489 proc click {w x y shift wx wy} {
1490         global ui_index ui_other file_lists
1492         set pos [split [$w index @$x,$y] .]
1493         set lno [lindex $pos 0]
1494         set col [lindex $pos 1]
1495         set path [lindex $file_lists($w) [expr $lno - 1]]
1496         if {$path == {}} return
1498         if {$col > 0 && $shift == 1} {
1499                 show_diff $path $w $lno
1500         }
1503 proc unclick {w x y} {
1504         set pos [split [$w index @$x,$y] .]
1505         set lno [lindex $pos 0]
1506         set col [lindex $pos 1]
1507         set path [$w get $lno.1 $lno.end]
1508         if {$path == {}} return
1510         if {$col == 0} {
1511                 toggle_mode $path
1512         }
1515 ######################################################################
1516 ##
1517 ## ui init
1519 set mainfont {Helvetica 10}
1520 set difffont {Courier 10}
1521 set maincursor [. cget -cursor]
1523 switch -glob -- "$tcl_platform(platform),$tcl_platform(os)" {
1524 windows,*   {set M1B Control; set M1T Ctrl}
1525 unix,Darwin {set M1B M1; set M1T Cmd}
1526 default     {set M1B M1; set M1T M1}
1529 # -- Menu Bar
1530 menu .mbar -tearoff 0
1531 .mbar add cascade -label Project -menu .mbar.project
1532 .mbar add cascade -label Edit -menu .mbar.edit
1533 .mbar add cascade -label Commit -menu .mbar.commit
1534 .mbar add cascade -label Fetch -menu .mbar.fetch
1535 .mbar add cascade -label Pull -menu .mbar.pull
1536 .mbar add cascade -label Push -menu .mbar.push
1537 .mbar add cascade -label Options -menu .mbar.options
1538 . configure -menu .mbar
1540 # -- Project Menu
1541 menu .mbar.project
1542 .mbar.project add command -label Visualize \
1543         -command do_gitk \
1544         -font $mainfont
1545 .mbar.project add command -label {Repack Database} \
1546         -command do_repack \
1547         -font $mainfont
1548 .mbar.project add command -label Quit \
1549         -command do_quit \
1550         -accelerator $M1T-Q \
1551         -font $mainfont
1553 # -- Edit Menu
1555 menu .mbar.edit
1556 .mbar.edit add command -label Undo \
1557         -command {catch {[focus] edit undo}} \
1558         -accelerator $M1T-Z \
1559         -font $mainfont
1560 .mbar.edit add command -label Redo \
1561         -command {catch {[focus] edit redo}} \
1562         -accelerator $M1T-Y \
1563         -font $mainfont
1564 .mbar.edit add separator
1565 .mbar.edit add command -label Cut \
1566         -command {catch {tk_textCut [focus]}} \
1567         -accelerator $M1T-X \
1568         -font $mainfont
1569 .mbar.edit add command -label Copy \
1570         -command {catch {tk_textCopy [focus]}} \
1571         -accelerator $M1T-C \
1572         -font $mainfont
1573 .mbar.edit add command -label Paste \
1574         -command {catch {tk_textPaste [focus]; [focus] see insert}} \
1575         -accelerator $M1T-V \
1576         -font $mainfont
1577 .mbar.edit add command -label Delete \
1578         -command {catch {[focus] delete sel.first sel.last}} \
1579         -accelerator Del \
1580         -font $mainfont
1581 .mbar.edit add separator
1582 .mbar.edit add command -label {Select All} \
1583         -command {catch {[focus] tag add sel 0.0 end}} \
1584         -accelerator $M1T-A \
1585         -font $mainfont
1587 # -- Commit Menu
1588 menu .mbar.commit
1589 .mbar.commit add command -label Rescan \
1590         -command do_rescan \
1591         -accelerator F5 \
1592         -font $mainfont
1593 lappend disable_on_lock \
1594         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1595 .mbar.commit add command -label {Amend Last Commit} \
1596         -command do_amend_last \
1597         -font $mainfont
1598 lappend disable_on_lock \
1599         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1600 .mbar.commit add command -label {Include All Files} \
1601         -command do_include_all \
1602         -accelerator $M1T-I \
1603         -font $mainfont
1604 lappend disable_on_lock \
1605         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1606 .mbar.commit add command -label {Sign Off} \
1607         -command do_signoff \
1608         -accelerator $M1T-S \
1609         -font $mainfont
1610 .mbar.commit add command -label Commit \
1611         -command do_commit \
1612         -accelerator $M1T-Return \
1613         -font $mainfont
1614 lappend disable_on_lock \
1615         [list .mbar.commit entryconf [.mbar.commit index last] -state]
1617 # -- Fetch Menu
1618 menu .mbar.fetch
1620 # -- Pull Menu
1621 menu .mbar.pull
1623 # -- Push Menu
1624 menu .mbar.push
1626 # -- Options Menu
1627 menu .mbar.options
1628 .mbar.options add checkbutton \
1629         -label {Trust File Modification Timestamps} \
1630         -offvalue false \
1631         -onvalue true \
1632         -variable cfg_trust_mtime
1634 # -- Main Window Layout
1635 panedwindow .vpane -orient vertical
1636 panedwindow .vpane.files -orient horizontal
1637 .vpane add .vpane.files -sticky nsew -height 100 -width 400
1638 pack .vpane -anchor n -side top -fill both -expand 1
1640 # -- Index File List
1641 frame .vpane.files.index -height 100 -width 400
1642 label .vpane.files.index.title -text {Modified Files} \
1643         -background green \
1644         -font $mainfont
1645 text $ui_index -background white -borderwidth 0 \
1646         -width 40 -height 10 \
1647         -font $mainfont \
1648         -yscrollcommand {.vpane.files.index.sb set} \
1649         -cursor $maincursor \
1650         -state disabled
1651 scrollbar .vpane.files.index.sb -command [list $ui_index yview]
1652 pack .vpane.files.index.title -side top -fill x
1653 pack .vpane.files.index.sb -side right -fill y
1654 pack $ui_index -side left -fill both -expand 1
1655 .vpane.files add .vpane.files.index -sticky nsew
1657 # -- Other (Add) File List
1658 frame .vpane.files.other -height 100 -width 100
1659 label .vpane.files.other.title -text {Untracked Files} \
1660         -background red \
1661         -font $mainfont
1662 text $ui_other -background white -borderwidth 0 \
1663         -width 40 -height 10 \
1664         -font $mainfont \
1665         -yscrollcommand {.vpane.files.other.sb set} \
1666         -cursor $maincursor \
1667         -state disabled
1668 scrollbar .vpane.files.other.sb -command [list $ui_other yview]
1669 pack .vpane.files.other.title -side top -fill x
1670 pack .vpane.files.other.sb -side right -fill y
1671 pack $ui_other -side left -fill both -expand 1
1672 .vpane.files add .vpane.files.other -sticky nsew
1674 $ui_index tag conf in_diff -font [concat $mainfont bold]
1675 $ui_other tag conf in_diff -font [concat $mainfont bold]
1677 # -- Diff and Commit Area
1678 frame .vpane.lower -height 400 -width 400
1679 frame .vpane.lower.commarea
1680 frame .vpane.lower.diff -relief sunken -borderwidth 1
1681 pack .vpane.lower.commarea -side top -fill x
1682 pack .vpane.lower.diff -side bottom -fill both -expand 1
1683 .vpane add .vpane.lower -stick nsew
1685 # -- Commit Area Buttons
1686 frame .vpane.lower.commarea.buttons
1687 label .vpane.lower.commarea.buttons.l -text {} \
1688         -anchor w \
1689         -justify left \
1690         -font $mainfont
1691 pack .vpane.lower.commarea.buttons.l -side top -fill x
1692 pack .vpane.lower.commarea.buttons -side left -fill y
1694 button .vpane.lower.commarea.buttons.rescan -text {Rescan} \
1695         -command do_rescan \
1696         -font $mainfont
1697 pack .vpane.lower.commarea.buttons.rescan -side top -fill x
1698 lappend disable_on_lock {.vpane.lower.commarea.buttons.rescan conf -state}
1700 button .vpane.lower.commarea.buttons.amend -text {Amend Last} \
1701         -command do_amend_last \
1702         -font $mainfont
1703 pack .vpane.lower.commarea.buttons.amend -side top -fill x
1704 lappend disable_on_lock {.vpane.lower.commarea.buttons.amend conf -state}
1706 button .vpane.lower.commarea.buttons.incall -text {Include All} \
1707         -command do_include_all \
1708         -font $mainfont
1709 pack .vpane.lower.commarea.buttons.incall -side top -fill x
1710 lappend disable_on_lock {.vpane.lower.commarea.buttons.incall conf -state}
1712 button .vpane.lower.commarea.buttons.signoff -text {Sign Off} \
1713         -command do_signoff \
1714         -font $mainfont
1715 pack .vpane.lower.commarea.buttons.signoff -side top -fill x
1717 button .vpane.lower.commarea.buttons.commit -text {Commit} \
1718         -command do_commit \
1719         -font $mainfont
1720 pack .vpane.lower.commarea.buttons.commit -side top -fill x
1721 lappend disable_on_lock {.vpane.lower.commarea.buttons.commit conf -state}
1723 # -- Commit Message Buffer
1724 frame .vpane.lower.commarea.buffer
1725 set ui_comm .vpane.lower.commarea.buffer.t
1726 set ui_coml .vpane.lower.commarea.buffer.l
1727 label $ui_coml -text {Commit Message:} \
1728         -anchor w \
1729         -justify left \
1730         -font $mainfont
1731 trace add variable commit_type write {uplevel #0 {
1732         switch -glob $commit_type \
1733         initial {$ui_coml conf -text {Initial Commit Message:}} \
1734         amend   {$ui_coml conf -text {Amended Commit Message:}} \
1735         merge   {$ui_coml conf -text {Merge Commit Message:}} \
1736         *       {$ui_coml conf -text {Commit Message:}}
1737 }}
1738 text $ui_comm -background white -borderwidth 1 \
1739         -undo true \
1740         -maxundo 20 \
1741         -autoseparators true \
1742         -relief sunken \
1743         -width 75 -height 9 -wrap none \
1744         -font $difffont \
1745         -yscrollcommand {.vpane.lower.commarea.buffer.sby set} \
1746         -cursor $maincursor
1747 scrollbar .vpane.lower.commarea.buffer.sby -command [list $ui_comm yview]
1748 pack $ui_coml -side top -fill x
1749 pack .vpane.lower.commarea.buffer.sby -side right -fill y
1750 pack $ui_comm -side left -fill y
1751 pack .vpane.lower.commarea.buffer -side left -fill y
1753 # -- Diff Header
1754 set ui_fname_value {}
1755 set ui_fstatus_value {}
1756 frame .vpane.lower.diff.header -background orange
1757 label .vpane.lower.diff.header.l1 -text {File:} \
1758         -background orange \
1759         -font $mainfont
1760 label .vpane.lower.diff.header.l2 -textvariable ui_fname_value \
1761         -background orange \
1762         -anchor w \
1763         -justify left \
1764         -font $mainfont
1765 label .vpane.lower.diff.header.l3 -text {Status:} \
1766         -background orange \
1767         -font $mainfont
1768 label .vpane.lower.diff.header.l4 -textvariable ui_fstatus_value \
1769         -background orange \
1770         -width $max_status_desc \
1771         -anchor w \
1772         -justify left \
1773         -font $mainfont
1774 pack .vpane.lower.diff.header.l1 -side left
1775 pack .vpane.lower.diff.header.l2 -side left -fill x
1776 pack .vpane.lower.diff.header.l4 -side right
1777 pack .vpane.lower.diff.header.l3 -side right
1779 # -- Diff Body
1780 frame .vpane.lower.diff.body
1781 set ui_diff .vpane.lower.diff.body.t
1782 text $ui_diff -background white -borderwidth 0 \
1783         -width 80 -height 15 -wrap none \
1784         -font $difffont \
1785         -xscrollcommand {.vpane.lower.diff.body.sbx set} \
1786         -yscrollcommand {.vpane.lower.diff.body.sby set} \
1787         -cursor $maincursor \
1788         -state disabled
1789 scrollbar .vpane.lower.diff.body.sbx -orient horizontal \
1790         -command [list $ui_diff xview]
1791 scrollbar .vpane.lower.diff.body.sby -orient vertical \
1792         -command [list $ui_diff yview]
1793 pack .vpane.lower.diff.body.sbx -side bottom -fill x
1794 pack .vpane.lower.diff.body.sby -side right -fill y
1795 pack $ui_diff -side left -fill both -expand 1
1796 pack .vpane.lower.diff.header -side top -fill x
1797 pack .vpane.lower.diff.body -side bottom -fill both -expand 1
1799 $ui_diff tag conf dm -foreground red
1800 $ui_diff tag conf dp -foreground blue
1801 $ui_diff tag conf da -font [concat $difffont bold]
1802 $ui_diff tag conf di -foreground "#00a000"
1803 $ui_diff tag conf dni -foreground "#a000a0"
1804 $ui_diff tag conf bold -font [concat $difffont bold]
1806 # -- Status Bar
1807 set ui_status_value {Initializing...}
1808 label .status -textvariable ui_status_value \
1809         -anchor w \
1810         -justify left \
1811         -borderwidth 1 \
1812         -relief sunken \
1813         -font $mainfont
1814 pack .status -anchor w -side bottom -fill x
1816 # -- Load geometry
1817 catch {
1818 wm geometry . [lindex $repo_config(gui.geometry) 0 0]
1819 eval .vpane sash place 0 [lindex $repo_config(gui.geometry) 0 1]
1820 eval .vpane.files sash place 0 [lindex $repo_config(gui.geometry) 0 2]
1823 # -- Key Bindings
1824 bind $ui_comm <$M1B-Key-Return> {do_commit;break}
1825 bind $ui_comm <$M1B-Key-i> {do_include_all;break}
1826 bind $ui_comm <$M1B-Key-I> {do_include_all;break}
1827 bind $ui_comm <$M1B-Key-x> {tk_textCut %W;break}
1828 bind $ui_comm <$M1B-Key-X> {tk_textCut %W;break}
1829 bind $ui_comm <$M1B-Key-c> {tk_textCopy %W;break}
1830 bind $ui_comm <$M1B-Key-C> {tk_textCopy %W;break}
1831 bind $ui_comm <$M1B-Key-v> {tk_textPaste %W; %W see insert; break}
1832 bind $ui_comm <$M1B-Key-V> {tk_textPaste %W; %W see insert; break}
1833 bind $ui_comm <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1834 bind $ui_comm <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1836 bind $ui_diff <$M1B-Key-x> {tk_textCopy %W;break}
1837 bind $ui_diff <$M1B-Key-X> {tk_textCopy %W;break}
1838 bind $ui_diff <$M1B-Key-c> {tk_textCopy %W;break}
1839 bind $ui_diff <$M1B-Key-C> {tk_textCopy %W;break}
1840 bind $ui_diff <$M1B-Key-v> {break}
1841 bind $ui_diff <$M1B-Key-V> {break}
1842 bind $ui_diff <$M1B-Key-a> {%W tag add sel 0.0 end;break}
1843 bind $ui_diff <$M1B-Key-A> {%W tag add sel 0.0 end;break}
1844 bind $ui_diff <Key-Up>     {catch {%W yview scroll -1 units};break}
1845 bind $ui_diff <Key-Down>   {catch {%W yview scroll  1 units};break}
1846 bind $ui_diff <Key-Left>   {catch {%W xview scroll -1 units};break}
1847 bind $ui_diff <Key-Right>  {catch {%W xview scroll  1 units};break}
1849 bind .   <Destroy> do_quit
1850 bind all <Key-F5> do_rescan
1851 bind all <$M1B-Key-r> do_rescan
1852 bind all <$M1B-Key-R> do_rescan
1853 bind .   <$M1B-Key-s> do_signoff
1854 bind .   <$M1B-Key-S> do_signoff
1855 bind .   <$M1B-Key-i> do_include_all
1856 bind .   <$M1B-Key-I> do_include_all
1857 bind .   <$M1B-Key-Return> do_commit
1858 bind all <$M1B-Key-q> do_quit
1859 bind all <$M1B-Key-Q> do_quit
1860 bind all <$M1B-Key-w> {destroy [winfo toplevel %W]}
1861 bind all <$M1B-Key-W> {destroy [winfo toplevel %W]}
1862 foreach i [list $ui_index $ui_other] {
1863         bind $i <Button-1> {click %W %x %y 1 %X %Y; break}
1864         bind $i <Button-3> {click %W %x %y 3 %X %Y; break}
1865         bind $i <ButtonRelease-1> {unclick %W %x %y; break}
1867 unset i M1B M1T
1869 wm title . "$appname ([file normalize [file dirname $gitdir]])"
1870 focus -force $ui_comm
1871 load_all_remotes
1872 populate_remote_menu .mbar.fetch From fetch_from
1873 populate_remote_menu .mbar.push To push_to
1874 populate_pull_menu .mbar.pull
1875 update_status