Code

git-gui: Updated TODO list now that geometry is stored.
[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
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         foreach w [list $ui_index $ui_other] {
170                 $w conf -state normal
171                 $w delete 0.0 end
172                 $w conf -state disabled
173         }
175         if {![$ui_comm edit modified]
176                 || [string trim [$ui_comm get 0.0 end]] == {}} {
177                 if {[load_message GITGUI_MSG]} {
178                 } elseif {[load_message MERGE_MSG]} {
179                 } elseif {[load_message SQUASH_MSG]} {
180                 }
181                 $ui_comm edit modified false
182                 $ui_comm edit reset
183         }
185         if {$cfg_trust_mtime == {true}} {
186                 update_status_stage2 {} $final
187         } else {
188                 set status_active 1
189                 set ui_status_value {Refreshing file status...}
190                 set fd_rf [open "| git update-index -q --unmerged --refresh" r]
191                 fconfigure $fd_rf -blocking 0 -translation binary
192                 fileevent $fd_rf readable [list update_status_stage2 $fd_rf $final]
193         }
196 proc update_status_stage2 {fd final} {
197         global gitdir PARENT commit_type
198         global ui_index ui_other ui_status_value ui_comm
199         global status_active file_states
200         global buf_rdi buf_rdf buf_rlo
202         if {$fd != {}} {
203                 read $fd
204                 if {![eof $fd]} return
205                 close $fd
206         }
208         set ls_others [list | git ls-files --others -z \
209                 --exclude-per-directory=.gitignore]
210         set info_exclude [file join $gitdir info exclude]
211         if {[file readable $info_exclude]} {
212                 lappend ls_others "--exclude-from=$info_exclude"
213         }
215         set buf_rdi {}
216         set buf_rdf {}
217         set buf_rlo {}
219         set status_active 3
220         set ui_status_value {Scanning for modified files ...}
221         set fd_di [open "| git diff-index --cached -z $PARENT" r]
222         set fd_df [open "| git diff-files -z" r]
223         set fd_lo [open $ls_others r]
225         fconfigure $fd_di -blocking 0 -translation binary
226         fconfigure $fd_df -blocking 0 -translation binary
227         fconfigure $fd_lo -blocking 0 -translation binary
228         fileevent $fd_di readable [list read_diff_index $fd_di $final]
229         fileevent $fd_df readable [list read_diff_files $fd_df $final]
230         fileevent $fd_lo readable [list read_ls_others $fd_lo $final]
233 proc load_message {file} {
234         global gitdir ui_comm
236         set f [file join $gitdir $file]
237         if {[file isfile $f]} {
238                 if {[catch {set fd [open $f r]}]} {
239                         return 0
240                 }
241                 set content [string trim [read $fd]]
242                 close $fd
243                 $ui_comm delete 0.0 end
244                 $ui_comm insert end $content
245                 return 1
246         }
247         return 0
250 proc read_diff_index {fd final} {
251         global buf_rdi
253         append buf_rdi [read $fd]
254         set c 0
255         set n [string length $buf_rdi]
256         while {$c < $n} {
257                 set z1 [string first "\0" $buf_rdi $c]
258                 if {$z1 == -1} break
259                 incr z1
260                 set z2 [string first "\0" $buf_rdi $z1]
261                 if {$z2 == -1} break
263                 set c $z2
264                 incr z2 -1
265                 display_file \
266                         [string range $buf_rdi $z1 $z2] \
267                         [string index $buf_rdi [expr $z1 - 2]]_
268                 incr c
269         }
270         if {$c < $n} {
271                 set buf_rdi [string range $buf_rdi $c end]
272         } else {
273                 set buf_rdi {}
274         }
276         status_eof $fd buf_rdi $final
279 proc read_diff_files {fd final} {
280         global buf_rdf
282         append buf_rdf [read $fd]
283         set c 0
284         set n [string length $buf_rdf]
285         while {$c < $n} {
286                 set z1 [string first "\0" $buf_rdf $c]
287                 if {$z1 == -1} break
288                 incr z1
289                 set z2 [string first "\0" $buf_rdf $z1]
290                 if {$z2 == -1} break
292                 set c $z2
293                 incr z2 -1
294                 display_file \
295                         [string range $buf_rdf $z1 $z2] \
296                         _[string index $buf_rdf [expr $z1 - 2]]
297                 incr c
298         }
299         if {$c < $n} {
300                 set buf_rdf [string range $buf_rdf $c end]
301         } else {
302                 set buf_rdf {}
303         }
305         status_eof $fd buf_rdf $final
308 proc read_ls_others {fd final} {
309         global buf_rlo
311         append buf_rlo [read $fd]
312         set pck [split $buf_rlo "\0"]
313         set buf_rlo [lindex $pck end]
314         foreach p [lrange $pck 0 end-1] {
315                 display_file $p _O
316         }
317         status_eof $fd buf_rlo $final
320 proc status_eof {fd buf final} {
321         global status_active $buf
322         global ui_fname_value ui_status_value file_states
324         if {[eof $fd]} {
325                 set $buf {}
326                 close $fd
328                 if {[incr status_active -1] == 0} {
329                         unlock_index
331                         display_all_files
332                         set ui_status_value $final
334                         if {$ui_fname_value != {} && [array names file_states \
335                                 -exact $ui_fname_value] != {}}  {
336                                 show_diff $ui_fname_value
337                         } else {
338                                 clear_diff
339                         }
340                 }
341         }
344 ######################################################################
345 ##
346 ## diff
348 proc clear_diff {} {
349         global ui_diff ui_fname_value ui_fstatus_value
351         $ui_diff conf -state normal
352         $ui_diff delete 0.0 end
353         $ui_diff conf -state disabled
354         set ui_fname_value {}
355         set ui_fstatus_value {}
358 proc show_diff {path} {
359         global file_states PARENT diff_3way diff_active
360         global ui_diff ui_fname_value ui_fstatus_value ui_status_value
362         if {$diff_active || ![lock_index read]} return
364         clear_diff
365         set s $file_states($path)
366         set m [lindex $s 0]
367         set diff_3way 0
368         set diff_active 1
369         set ui_fname_value $path
370         set ui_fstatus_value [mapdesc $m $path]
371         set ui_status_value "Loading diff of $path..."
373         set cmd [list | git diff-index -p $PARENT -- $path]
374         switch $m {
375         AM {
376         }
377         MM {
378                 set cmd [list | git diff-index -p -c $PARENT $path]
379         }
380         _O {
381                 if {[catch {
382                                 set fd [open $path r]
383                                 set content [read $fd]
384                                 close $fd
385                         } err ]} {
386                         set diff_active 0
387                         unlock_index
388                         set ui_status_value "Unable to display $path"
389                         error_popup "Error loading file:\n$err"
390                         return
391                 }
392                 $ui_diff conf -state normal
393                 $ui_diff insert end $content
394                 $ui_diff conf -state disabled
395                 set diff_active 0
396                 unlock_index
397                 set ui_status_value {Ready.}
398                 return
399         }
400         }
402         if {[catch {set fd [open $cmd r]} err]} {
403                 set diff_active 0
404                 unlock_index
405                 set ui_status_value "Unable to display $path"
406                 error_popup "Error loading diff:\n$err"
407                 return
408         }
410         fconfigure $fd -blocking 0 -translation auto
411         fileevent $fd readable [list read_diff $fd]
414 proc read_diff {fd} {
415         global ui_diff ui_status_value diff_3way diff_active
417         while {[gets $fd line] >= 0} {
418                 if {[string match {diff --git *} $line]} continue
419                 if {[string match {diff --combined *} $line]} continue
420                 if {[string match {--- *} $line]} continue
421                 if {[string match {+++ *} $line]} continue
422                 if {[string match index* $line]} {
423                         if {[string first , $line] >= 0} {
424                                 set diff_3way 1
425                         }
426                 }
428                 $ui_diff conf -state normal
429                 if {!$diff_3way} {
430                         set x [string index $line 0]
431                         switch -- $x {
432                         "@" {set tags da}
433                         "+" {set tags dp}
434                         "-" {set tags dm}
435                         default {set tags {}}
436                         }
437                 } else {
438                         set x [string range $line 0 1]
439                         switch -- $x {
440                         default {set tags {}}
441                         "@@" {set tags da}
442                         "++" {set tags dp; set x " +"}
443                         " +" {set tags {di bold}; set x "++"}
444                         "+ " {set tags dni; set x "-+"}
445                         "--" {set tags dm; set x " -"}
446                         " -" {set tags {dm bold}; set x "--"}
447                         "- " {set tags di; set x "+-"}
448                         default {set tags {}}
449                         }
450                         set line [string replace $line 0 1 $x]
451                 }
452                 $ui_diff insert end $line $tags
453                 $ui_diff insert end "\n"
454                 $ui_diff conf -state disabled
455         }
457         if {[eof $fd]} {
458                 close $fd
459                 set diff_active 0
460                 unlock_index
461                 set ui_status_value {Ready.}
462         }
465 ######################################################################
466 ##
467 ## commit
469 proc load_last_commit {} {
470         global HEAD PARENT commit_type ui_comm
472         if {$commit_type == {amend}} return
473         if {$commit_type != {normal}} {
474                 error_popup "Can't amend a $commit_type commit."
475                 return
476         }
478         set msg {}
479         set parent {}
480         set parent_count 0
481         if {[catch {
482                         set fd [open "| git cat-file commit $HEAD" r]
483                         while {[gets $fd line] > 0} {
484                                 if {[string match {parent *} $line]} {
485                                         set parent [string range $line 7 end]
486                                         incr parent_count
487                                 }
488                         }
489                         set msg [string trim [read $fd]]
490                         close $fd
491                 } err]} {
492                 error_popup "Error loading commit data for amend:\n$err"
493                 return
494         }
496         if {$parent_count == 0} {
497                 set commit_type amend
498                 set HEAD {}
499                 set PARENT {}
500                 update_status
501         } elseif {$parent_count == 1} {
502                 set commit_type amend
503                 set PARENT $parent
504                 $ui_comm delete 0.0 end
505                 $ui_comm insert end $msg
506                 $ui_comm edit modified false
507                 $ui_comm edit reset
508                 update_status
509         } else {
510                 error_popup {You can't amend a merge commit.}
511                 return
512         }
515 proc commit_tree {} {
516         global tcl_platform HEAD gitdir commit_type file_states
517         global commit_active ui_status_value
518         global ui_comm
520         if {$commit_active || ![lock_index update]} return
522         # -- Our in memory state should match the repository.
523         #
524         repository_state curHEAD cur_type
525         if {$commit_type == {amend} 
526                 && $cur_type == {normal}
527                 && $curHEAD == $HEAD} {
528         } elseif {$commit_type != $cur_type || $HEAD != $curHEAD} {
529                 error_popup {Last scanned state does not match repository state.
531 Its highly likely that another Git program modified the
532 repository since our last scan.  A rescan is required
533 before committing.
535                 unlock_index
536                 update_status
537                 return
538         }
540         # -- At least one file should differ in the index.
541         #
542         set files_ready 0
543         foreach path [array names file_states] {
544                 set s $file_states($path)
545                 switch -glob -- [lindex $s 0] {
546                 _* {continue}
547                 A* -
548                 D* -
549                 M* {set files_ready 1; break}
550                 U* {
551                         error_popup "Unmerged files cannot be committed.
553 File $path has merge conflicts.
554 You must resolve them and include the file before committing.
556                         unlock_index
557                         return
558                 }
559                 default {
560                         error_popup "Unknown file state [lindex $s 0] detected.
562 File $path cannot be committed by this program.
564                 }
565                 }
566         }
567         if {!$files_ready} {
568                 error_popup {No included files to commit.
570 You must include at least 1 file before you can commit.
572                 unlock_index
573                 return
574         }
576         # -- A message is required.
577         #
578         set msg [string trim [$ui_comm get 1.0 end]]
579         if {$msg == {}} {
580                 error_popup {Please supply a commit message.
582 A good commit message has the following format:
584 - First line: Describe in one sentance what you did.
585 - Second line: Blank
586 - Remaining lines: Describe why this change is good.
588                 unlock_index
589                 return
590         }
592         # -- Ask the pre-commit hook for the go-ahead.
593         #
594         set pchook [file join $gitdir hooks pre-commit]
595         if {$tcl_platform(platform) == {windows} && [file isfile $pchook]} {
596                 set pchook [list sh -c \
597                         "if test -x \"$pchook\"; then exec \"$pchook\"; fi"]
598         } elseif {[file executable $pchook]} {
599                 set pchook [list $pchook]
600         } else {
601                 set pchook {}
602         }
603         if {$pchook != {} && [catch {eval exec $pchook} err]} {
604                 hook_failed_popup pre-commit $err
605                 unlock_index
606                 return
607         }
609         # -- Write the tree in the background.
610         #
611         set commit_active 1
612         set ui_status_value {Committing changes...}
614         set fd_wt [open "| git write-tree" r]
615         fileevent $fd_wt readable [list commit_stage2 $fd_wt $curHEAD $msg]
618 proc commit_stage2 {fd_wt curHEAD msg} {
619         global single_commit gitdir PARENT commit_type
620         global commit_active ui_status_value ui_comm
622         gets $fd_wt tree_id
623         close $fd_wt
625         if {$tree_id == {}} {
626                 error_popup "write-tree failed"
627                 set commit_active 0
628                 set ui_status_value {Commit failed.}
629                 unlock_index
630                 return
631         }
633         # -- Create the commit.
634         #
635         set cmd [list git commit-tree $tree_id]
636         if {$PARENT != {}} {
637                 lappend cmd -p $PARENT
638         }
639         if {$commit_type == {merge}} {
640                 if {[catch {
641                                 set fd_mh [open [file join $gitdir MERGE_HEAD] r]
642                                 while {[gets $fd_mh merge_head] >= 0} {
643                                         lappend cmd -p $merge_head
644                                 }
645                                 close $fd_mh
646                         } err]} {
647                         error_popup "Loading MERGE_HEADs failed:\n$err"
648                         set commit_active 0
649                         set ui_status_value {Commit failed.}
650                         unlock_index
651                         return
652                 }
653         }
654         if {$PARENT == {}} {
655                 # git commit-tree writes to stderr during initial commit.
656                 lappend cmd 2>/dev/null
657         }
658         lappend cmd << $msg
659         if {[catch {set cmt_id [eval exec $cmd]} err]} {
660                 error_popup "commit-tree failed:\n$err"
661                 set commit_active 0
662                 set ui_status_value {Commit failed.}
663                 unlock_index
664                 return
665         }
667         # -- Update the HEAD ref.
668         #
669         set reflogm commit
670         if {$commit_type != {normal}} {
671                 append reflogm " ($commit_type)"
672         }
673         set i [string first "\n" $msg]
674         if {$i >= 0} {
675                 append reflogm {: } [string range $msg 0 [expr $i - 1]]
676         } else {
677                 append reflogm {: } $msg
678         }
679         set cmd [list git update-ref -m $reflogm HEAD $cmt_id $curHEAD]
680         if {[catch {eval exec $cmd} err]} {
681                 error_popup "update-ref failed:\n$err"
682                 set commit_active 0
683                 set ui_status_value {Commit failed.}
684                 unlock_index
685                 return
686         }
688         # -- Cleanup after ourselves.
689         #
690         catch {file delete [file join $gitdir MERGE_HEAD]}
691         catch {file delete [file join $gitdir MERGE_MSG]}
692         catch {file delete [file join $gitdir SQUASH_MSG]}
693         catch {file delete [file join $gitdir GITGUI_MSG]}
695         # -- Let rerere do its thing.
696         #
697         if {[file isdirectory [file join $gitdir rr-cache]]} {
698                 catch {exec git rerere}
699         }
701         $ui_comm delete 0.0 end
702         $ui_comm edit modified false
703         $ui_comm edit reset
705         if {$single_commit} do_quit
707         set commit_type {}
708         set commit_active 0
709         set HEAD $cmt_id
710         set PARENT $cmt_id
711         unlock_index
712         update_status "Changes committed as [string range $cmt_id 0 7]."
715 ######################################################################
716 ##
717 ## fetch pull push
719 proc fetch_from {remote} {
720         set w [new_console "fetch $remote" \
721                 "Fetching new changes from $remote"]
722         set cmd [list git fetch]
723         lappend cmd $remote
724         console_exec $w $cmd
727 proc pull_remote {remote branch} {
728         global HEAD commit_type
729         global file_states
731         if {![lock_index update]} return
733         # -- Our in memory state should match the repository.
734         #
735         repository_state curHEAD cur_type
736         if {$commit_type != $cur_type || $HEAD != $curHEAD} {
737                 error_popup {Last scanned state does not match repository state.
739 Its highly likely that another Git program modified the
740 repository since our last scan.  A rescan is required
741 before a pull can be started.
743                 unlock_index
744                 update_status
745                 return
746         }
748         # -- No differences should exist before a pull.
749         #
750         if {[array size file_states] != 0} {
751                 error_popup {Uncommitted but modified files are present.
753 You should not perform a pull with unmodified files in your working
754 directory as Git would be unable to recover from an incorrect merge.
756 Commit or throw away all changes before starting a pull operation.
758                 unlock_index
759                 return
760         }
762         set w [new_console "pull $remote $branch" \
763                 "Pulling new changes from branch $branch in $remote"]
764         set cmd [list git pull]
765         lappend cmd $remote
766         lappend cmd $branch
767         console_exec $w $cmd [list post_pull_remote $remote $branch]
770 proc post_pull_remote {remote branch success} {
771         global HEAD PARENT commit_type
772         global ui_status_value
774         unlock_index
775         if {$success} {
776                 repository_state HEAD commit_type
777                 set PARENT $HEAD
778                 set $ui_status_value {Ready.}
779         } else {
780                 update_status "Conflicts detected while pulling $branch from $remote."
781         }
784 proc push_to {remote} {
785         set w [new_console "push $remote" \
786                 "Pushing changes to $remote"]
787         set cmd [list git push]
788         lappend cmd $remote
789         console_exec $w $cmd
792 ######################################################################
793 ##
794 ## ui helpers
796 proc mapcol {state path} {
797         global all_cols ui_other
799         if {[catch {set r $all_cols($state)}]} {
800                 puts "error: no column for state={$state} $path"
801                 return $ui_other
802         }
803         return $r
806 proc mapicon {state path} {
807         global all_icons
809         if {[catch {set r $all_icons($state)}]} {
810                 puts "error: no icon for state={$state} $path"
811                 return file_plain
812         }
813         return $r
816 proc mapdesc {state path} {
817         global all_descs
819         if {[catch {set r $all_descs($state)}]} {
820                 puts "error: no desc for state={$state} $path"
821                 return $state
822         }
823         return $r
826 proc bsearch {w path} {
827         set hi [expr [lindex [split [$w index end] .] 0] - 2]
828         if {$hi == 0} {
829                 return -1
830         }
831         set lo 0
832         while {$lo < $hi} {
833                 set mi [expr [expr $lo + $hi] / 2]
834                 set ti [expr $mi + 1]
835                 set cmp [string compare [$w get $ti.1 $ti.end] $path]
836                 if {$cmp < 0} {
837                         set lo $ti
838                 } elseif {$cmp == 0} {
839                         return $mi
840                 } else {
841                         set hi $mi
842                 }
843         }
844         return -[expr $lo + 1]
847 set next_icon_id 0
849 proc merge_state {path new_state} {
850         global file_states next_icon_id
852         set s0 [string index $new_state 0]
853         set s1 [string index $new_state 1]
855         if {[catch {set info $file_states($path)}]} {
856                 set state __
857                 set icon n[incr next_icon_id]
858         } else {
859                 set state [lindex $info 0]
860                 set icon [lindex $info 1]
861         }
863         if {$s0 == {_}} {
864                 set s0 [string index $state 0]
865         } elseif {$s0 == {*}} {
866                 set s0 _
867         }
869         if {$s1 == {_}} {
870                 set s1 [string index $state 1]
871         } elseif {$s1 == {*}} {
872                 set s1 _
873         }
875         set file_states($path) [list $s0$s1 $icon]
876         return $state
879 proc display_file {path state} {
880         global ui_index ui_other file_states status_active
882         set old_m [merge_state $path $state]
883         if {$status_active} return
885         set s $file_states($path)
886         set new_m [lindex $s 0]
887         set new_w [mapcol $new_m $path] 
888         set old_w [mapcol $old_m $path]
889         set new_icon [mapicon $new_m $path]
891         if {$new_w != $old_w} {
892                 set lno [bsearch $old_w $path]
893                 if {$lno >= 0} {
894                         incr lno
895                         $old_w conf -state normal
896                         $old_w delete $lno.0 [expr $lno + 1].0
897                         $old_w conf -state disabled
898                 }
900                 set lno [expr abs([bsearch $new_w $path] + 1) + 1]
901                 $new_w conf -state normal
902                 $new_w image create $lno.0 \
903                         -align center -padx 5 -pady 1 \
904                         -name [lindex $s 1] \
905                         -image $new_icon
906                 $new_w insert $lno.1 "$path\n"
907                 $new_w conf -state disabled
908         } elseif {$new_icon != [mapicon $old_m $path]} {
909                 $new_w conf -state normal
910                 $new_w image conf [lindex $s 1] -image $new_icon
911                 $new_w conf -state disabled
912         }
915 proc display_all_files {} {
916         global ui_index ui_other file_states
918         $ui_index conf -state normal
919         $ui_other conf -state normal
921         foreach path [lsort [array names file_states]] {
922                 set s $file_states($path)
923                 set m [lindex $s 0]
924                 set w [mapcol $m $path]
925                 $w image create end \
926                         -align center -padx 5 -pady 1 \
927                         -name [lindex $s 1] \
928                         -image [mapicon $m $path]
929                 $w insert end "$path\n"
930         }
932         $ui_index conf -state disabled
933         $ui_other conf -state disabled
936 proc with_update_index {body} {
937         global update_index_fd
939         if {$update_index_fd == {}} {
940                 if {![lock_index update]} return
941                 set update_index_fd [open \
942                         "| git update-index --add --remove -z --stdin" \
943                         w]
944                 fconfigure $update_index_fd -translation binary
945                 uplevel 1 $body
946                 close $update_index_fd
947                 set update_index_fd {}
948                 unlock_index
949         } else {
950                 uplevel 1 $body
951         }
954 proc update_index {path} {
955         global update_index_fd
957         if {$update_index_fd == {}} {
958                 error {not in with_update_index}
959         } else {
960                 puts -nonewline $update_index_fd "$path\0"
961         }
964 proc toggle_mode {path} {
965         global file_states ui_fname_value
967         set s $file_states($path)
968         set m [lindex $s 0]
970         switch -- $m {
971         AM -
972         _O {set new A*}
973         _M -
974         MM {set new M*}
975         AD -
976         _D {set new D*}
977         default {return}
978         }
980         with_update_index {update_index $path}
981         display_file $path $new
982         if {$ui_fname_value == $path} {
983                 show_diff $path
984         }
987 ######################################################################
988 ##
989 ## remote management
991 proc load_all_remotes {} {
992         global gitdir all_remotes repo_config
994         set all_remotes [list]
995         set rm_dir [file join $gitdir remotes]
996         if {[file isdirectory $rm_dir]} {
997                 set all_remotes [concat $all_remotes [glob \
998                         -types f \
999                         -tails \
1000                         -nocomplain \
1001                         -directory $rm_dir *]]
1002         }
1004         foreach line [array names repo_config remote.*.url] {
1005                 if {[regexp ^remote\.(.*)\.url\$ $line line name]} {
1006                         lappend all_remotes $name
1007                 }
1008         }
1010         set all_remotes [lsort -unique $all_remotes]
1013 proc populate_remote_menu {m pfx op} {
1014         global all_remotes mainfont
1016         foreach remote $all_remotes {
1017                 $m add command -label "$pfx $remote..." \
1018                         -command [list $op $remote] \
1019                         -font $mainfont
1020         }
1023 proc populate_pull_menu {m} {
1024         global gitdir repo_config all_remotes mainfont disable_on_lock
1026         foreach remote $all_remotes {
1027                 set rb {}
1028                 if {[array get repo_config remote.$remote.url] != {}} {
1029                         if {[array get repo_config remote.$remote.fetch] != {}} {
1030                                 regexp {^([^:]+):} \
1031                                         [lindex $repo_config(remote.$remote.fetch) 0] \
1032                                         line rb
1033                         }
1034                 } else {
1035                         catch {
1036                                 set fd [open [file join $gitdir remotes $remote] r]
1037                                 while {[gets $fd line] >= 0} {
1038                                         if {[regexp {^Pull:[ \t]*([^:]+):} $line line rb]} {
1039                                                 break
1040                                         }
1041                                 }
1042                                 close $fd
1043                         }
1044                 }
1046                 set rb_short $rb
1047                 regsub ^refs/heads/ $rb {} rb_short
1048                 if {$rb_short != {}} {
1049                         $m add command \
1050                                 -label "Branch $rb_short from $remote..." \
1051                                 -command [list pull_remote $remote $rb] \
1052                                 -font $mainfont
1053                         lappend disable_on_lock \
1054                                 [list $m entryconf [$m index last] -state]
1055                 }
1056         }
1059 ######################################################################
1060 ##
1061 ## icons
1063 set filemask {
1064 #define mask_width 14
1065 #define mask_height 15
1066 static unsigned char mask_bits[] = {
1067    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1068    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f,
1069    0xfe, 0x1f, 0xfe, 0x1f, 0xfe, 0x1f};
1072 image create bitmap file_plain -background white -foreground black -data {
1073 #define plain_width 14
1074 #define plain_height 15
1075 static unsigned char plain_bits[] = {
1076    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1077    0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10, 0x02, 0x10,
1078    0x02, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1079 } -maskdata $filemask
1081 image create bitmap file_mod -background white -foreground blue -data {
1082 #define mod_width 14
1083 #define mod_height 15
1084 static unsigned char mod_bits[] = {
1085    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1086    0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1087    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1088 } -maskdata $filemask
1090 image create bitmap file_fulltick -background white -foreground "#007000" -data {
1091 #define file_fulltick_width 14
1092 #define file_fulltick_height 15
1093 static unsigned char file_fulltick_bits[] = {
1094    0xfe, 0x01, 0x02, 0x1a, 0x02, 0x0c, 0x02, 0x0c, 0x02, 0x16, 0x02, 0x16,
1095    0x02, 0x13, 0x00, 0x13, 0x86, 0x11, 0x8c, 0x11, 0xd8, 0x10, 0xf2, 0x10,
1096    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1097 } -maskdata $filemask
1099 image create bitmap file_parttick -background white -foreground "#005050" -data {
1100 #define parttick_width 14
1101 #define parttick_height 15
1102 static unsigned char parttick_bits[] = {
1103    0xfe, 0x01, 0x02, 0x03, 0x7a, 0x05, 0x02, 0x09, 0x7a, 0x1f, 0x02, 0x10,
1104    0x7a, 0x14, 0x02, 0x16, 0x02, 0x13, 0x8a, 0x11, 0xda, 0x10, 0x72, 0x10,
1105    0x22, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1106 } -maskdata $filemask
1108 image create bitmap file_question -background white -foreground black -data {
1109 #define file_question_width 14
1110 #define file_question_height 15
1111 static unsigned char file_question_bits[] = {
1112    0xfe, 0x01, 0x02, 0x02, 0xe2, 0x04, 0xf2, 0x09, 0x1a, 0x1b, 0x0a, 0x13,
1113    0x82, 0x11, 0xc2, 0x10, 0x62, 0x10, 0x62, 0x10, 0x02, 0x10, 0x62, 0x10,
1114    0x62, 0x10, 0x02, 0x10, 0xfe, 0x1f};
1115 } -maskdata $filemask
1117 image create bitmap file_removed -background white -foreground red -data {
1118 #define file_removed_width 14
1119 #define file_removed_height 15
1120 static unsigned char file_removed_bits[] = {
1121    0xfe, 0x01, 0x02, 0x03, 0x02, 0x05, 0x02, 0x09, 0x02, 0x1f, 0x02, 0x10,
1122    0x1a, 0x16, 0x32, 0x13, 0xe2, 0x11, 0xc2, 0x10, 0xe2, 0x11, 0x32, 0x13,
1123    0x1a, 0x16, 0x02, 0x10, 0xfe, 0x1f};
1124 } -maskdata $filemask
1126 image create bitmap file_merge -background white -foreground blue -data {
1127 #define file_merge_width 14
1128 #define file_merge_height 15
1129 static unsigned char file_merge_bits[] = {
1130    0xfe, 0x01, 0x02, 0x03, 0x62, 0x05, 0x62, 0x09, 0x62, 0x1f, 0x62, 0x10,
1131    0xfa, 0x11, 0xf2, 0x10, 0x62, 0x10, 0x02, 0x10, 0xfa, 0x17, 0x02, 0x10,
1132    0xfa, 0x17, 0x02, 0x10, 0xfe, 0x1f};
1133 } -maskdata $filemask
1135 set ui_index .vpane.files.index.list
1136 set ui_other .vpane.files.other.list
1137 set max_status_desc 0
1138 foreach i {
1139                 {__ i plain    "Unmodified"}
1140                 {_M i mod      "Modified"}
1141                 {M_ i fulltick "Checked in"}
1142                 {MM i parttick "Partially included"}
1144                 {_O o plain    "Untracked"}
1145                 {A_ o fulltick "Added"}
1146                 {AM o parttick "Partially added"}
1147                 {AD o question "Added (but now gone)"}
1149                 {_D i question "Missing"}
1150                 {D_ i removed  "Removed"}
1151                 {DD i removed  "Removed"}
1152                 {DO i removed  "Removed (still exists)"}
1154                 {UM i merge    "Merge conflicts"}
1155                 {U_ i merge    "Merge conflicts"}
1156         } {
1157         if {$max_status_desc < [string length [lindex $i 3]]} {
1158                 set max_status_desc [string length [lindex $i 3]]
1159         }
1160         if {[lindex $i 1] == {i}} {
1161                 set all_cols([lindex $i 0]) $ui_index
1162         } else {
1163                 set all_cols([lindex $i 0]) $ui_other
1164         }
1165         set all_icons([lindex $i 0]) file_[lindex $i 2]
1166         set all_descs([lindex $i 0]) [lindex $i 3]
1168 unset filemask i
1170 ######################################################################
1171 ##
1172 ## util
1174 proc error_popup {msg} {
1175         set w .error
1176         toplevel $w
1177         wm transient $w .
1178         show_msg $w $w $msg
1181 proc show_msg {w top msg} {
1182         global gitdir appname mainfont
1184         message $w.m -text $msg -justify left -aspect 400
1185         pack $w.m -side top -fill x -padx 5 -pady 10
1186         button $w.ok -text OK \
1187                 -width 15 \
1188                 -font $mainfont \
1189                 -command "destroy $top"
1190         pack $w.ok -side bottom
1191         bind $top <Visibility> "grab $top; focus $top"
1192         bind $top <Key-Return> "destroy $top"
1193         wm title $w "$appname ([lindex [file split \
1194                 [file normalize [file dirname $gitdir]]] \
1195                 end]): error"
1196         tkwait window $top
1199 proc hook_failed_popup {hook msg} {
1200         global gitdir mainfont difffont appname
1202         set w .hookfail
1203         toplevel $w
1204         wm transient $w .
1206         frame $w.m
1207         label $w.m.l1 -text "$hook hook failed:" \
1208                 -anchor w \
1209                 -justify left \
1210                 -font [concat $mainfont bold]
1211         text $w.m.t \
1212                 -background white -borderwidth 1 \
1213                 -relief sunken \
1214                 -width 80 -height 10 \
1215                 -font $difffont \
1216                 -yscrollcommand [list $w.m.sby set]
1217         label $w.m.l2 \
1218                 -text {You must correct the above errors before committing.} \
1219                 -anchor w \
1220                 -justify left \
1221                 -font [concat $mainfont bold]
1222         scrollbar $w.m.sby -command [list $w.m.t yview]
1223         pack $w.m.l1 -side top -fill x
1224         pack $w.m.l2 -side bottom -fill x
1225         pack $w.m.sby -side right -fill y
1226         pack $w.m.t -side left -fill both -expand 1
1227         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1229         $w.m.t insert 1.0 $msg
1230         $w.m.t conf -state disabled
1232         button $w.ok -text OK \
1233                 -width 15 \
1234                 -font $mainfont \
1235                 -command "destroy $w"
1236         pack $w.ok -side bottom
1238         bind $w <Visibility> "grab $w; focus $w"
1239         bind $w <Key-Return> "destroy $w"
1240         wm title $w "$appname ([lindex [file split \
1241                 [file normalize [file dirname $gitdir]]] \
1242                 end]): error"
1243         tkwait window $w
1246 set next_console_id 0
1248 proc new_console {short_title long_title} {
1249         global next_console_id console_data
1250         set w .console[incr next_console_id]
1251         set console_data($w) [list $short_title $long_title]
1252         return [console_init $w]
1255 proc console_init {w} {
1256         global console_cr console_data
1257         global gitdir appname mainfont difffont
1259         set console_cr($w) 1.0
1260         toplevel $w
1261         frame $w.m
1262         label $w.m.l1 -text "[lindex $console_data($w) 1]:" \
1263                 -anchor w \
1264                 -justify left \
1265                 -font [concat $mainfont bold]
1266         text $w.m.t \
1267                 -background white -borderwidth 1 \
1268                 -relief sunken \
1269                 -width 80 -height 10 \
1270                 -font $difffont \
1271                 -state disabled \
1272                 -yscrollcommand [list $w.m.sby set]
1273         label $w.m.s -anchor w \
1274                 -justify left \
1275                 -font [concat $mainfont bold]
1276         scrollbar $w.m.sby -command [list $w.m.t yview]
1277         pack $w.m.l1 -side top -fill x
1278         pack $w.m.s -side bottom -fill x
1279         pack $w.m.sby -side right -fill y
1280         pack $w.m.t -side left -fill both -expand 1
1281         pack $w.m -side top -fill both -expand 1 -padx 5 -pady 10
1283         button $w.ok -text {Running...} \
1284                 -width 15 \
1285                 -font $mainfont \
1286                 -state disabled \
1287                 -command "destroy $w"
1288         pack $w.ok -side bottom
1290         bind $w <Visibility> "focus $w"
1291         wm title $w "$appname ([lindex [file split \
1292                 [file normalize [file dirname $gitdir]]] \
1293                 end]): [lindex $console_data($w) 0]"
1294         return $w
1297 proc console_exec {w cmd {after {}}} {
1298         global tcl_platform
1300         # -- Windows tosses the enviroment when we exec our child.
1301         #    But most users need that so we have to relogin. :-(
1302         #
1303         if {$tcl_platform(platform) == {windows}} {
1304                 set cmd [list sh --login -c "cd \"[pwd]\" && [join $cmd { }]"]
1305         }
1307         # -- Tcl won't let us redirect both stdout and stderr to
1308         #    the same pipe.  So pass it through cat...
1309         #
1310         set cmd [concat | $cmd |& cat]
1312         set fd_f [open $cmd r]
1313         fconfigure $fd_f -blocking 0 -translation binary
1314         fileevent $fd_f readable [list console_read $w $fd_f $after]
1317 proc console_read {w fd after} {
1318         global console_cr console_data
1320         set buf [read $fd]
1321         if {$buf != {}} {
1322                 if {![winfo exists $w]} {console_init $w}
1323                 $w.m.t conf -state normal
1324                 set c 0
1325                 set n [string length $buf]
1326                 while {$c < $n} {
1327                         set cr [string first "\r" $buf $c]
1328                         set lf [string first "\n" $buf $c]
1329                         if {$cr < 0} {set cr [expr $n + 1]}
1330                         if {$lf < 0} {set lf [expr $n + 1]}
1332                         if {$lf < $cr} {
1333                                 $w.m.t insert end [string range $buf $c $lf]
1334                                 set console_cr($w) [$w.m.t index {end -1c}]
1335                                 set c $lf
1336                                 incr c
1337                         } else {
1338                                 $w.m.t delete $console_cr($w) end
1339                                 $w.m.t insert end "\n"
1340                                 $w.m.t insert end [string range $buf $c $cr]
1341                                 set c $cr
1342                                 incr c
1343                         }
1344                 }
1345                 $w.m.t conf -state disabled
1346                 $w.m.t see end
1347         }
1349         fconfigure $fd -blocking 1
1350         if {[eof $fd]} {
1351                 if {[catch {close $fd}]} {
1352                         if {![winfo exists $w]} {console_init $w}
1353                         $w.m.s conf -background red -text {Error: Command Failed}
1354                         $w.ok conf -text Close
1355                         $w.ok conf -state normal
1356                         set ok 0
1357                 } elseif {[winfo exists $w]} {
1358                         $w.m.s conf -background green -text {Success}
1359                         $w.ok conf -text Close
1360                         $w.ok conf -state normal
1361                         set ok 1
1362                 }
1363                 array unset console_cr $w
1364                 array unset console_data $w
1365                 if {$after != {}} {
1366                         uplevel #0 $after $ok
1367                 }
1368                 return
1369         }
1370         fconfigure $fd -blocking 0
1373 ######################################################################
1374 ##
1375 ## ui commands
1377 set starting_gitk_msg {Please wait... Starting gitk...}
1379 proc do_gitk {} {
1380         global tcl_platform ui_status_value starting_gitk_msg
1382         set ui_status_value $starting_gitk_msg
1383         after 10000 {
1384                 if {$ui_status_value == $starting_gitk_msg} {
1385                         set ui_status_value {Ready.}
1386                 }
1387         }
1389         if {$tcl_platform(platform) == {windows}} {
1390                 exec sh -c gitk &
1391         } else {
1392                 exec gitk &
1393         }
1396 proc do_repack {} {
1397         set w [new_console "repack" "Repacking the object database"]
1398         set cmd [list git repack]
1399         lappend cmd -a
1400         lappend cmd -d
1401         console_exec $w $cmd
1404 proc do_quit {} {
1405         global gitdir ui_comm
1407         set save [file join $gitdir GITGUI_MSG]
1408         set msg [string trim [$ui_comm get 0.0 end]]
1409         if {[$ui_comm edit modified] && $msg != {}} {
1410                 catch {
1411                         set fd [open $save w]
1412                         puts $fd [string trim [$ui_comm get 0.0 end]]
1413                         close $fd
1414                 }
1415         } elseif {$msg == {} && [file exists $save]} {
1416                 file delete $save
1417         }
1419         save_my_config
1420         destroy .
1423 proc do_rescan {} {
1424         update_status
1427 proc do_include_all {} {
1428         global update_active ui_status_value
1430         if {$update_active || ![lock_index begin-update]} return
1432         set update_active 1
1433         set ui_status_value {Including all modified files...}
1434         after 1 {
1435                 with_update_index {
1436                         foreach path [array names file_states] {
1437                                 set s $file_states($path)
1438                                 set m [lindex $s 0]
1439                                 switch -- $m {
1440                                 AM -
1441                                 MM -
1442                                 _M -
1443                                 _D {toggle_mode $path}
1444                                 }
1445                         }
1446                 }
1447                 set update_active 0
1448                 set ui_status_value {Ready.}
1449         }
1452 proc do_signoff {} {
1453         global ui_comm GIT_COMMITTER_IDENT
1455         if {$GIT_COMMITTER_IDENT == {}} {
1456                 if {[catch {set me [exec git var GIT_COMMITTER_IDENT]} err]} {
1457                         error_popup "Unable to obtain your identity:\n$err"
1458                         return
1459                 }
1460                 if {![regexp {^(.*) [0-9]+ [-+0-9]+$} \
1461                         $me me GIT_COMMITTER_IDENT]} {
1462                         error_popup "Invalid GIT_COMMITTER_IDENT:\n$me"
1463                         return
1464                 }
1465         }
1467         set str "Signed-off-by: $GIT_COMMITTER_IDENT"
1468         if {[$ui_comm get {end -1c linestart} {end -1c}] != $str} {
1469                 $ui_comm edit separator
1470                 $ui_comm insert end "\n$str"
1471                 $ui_comm edit separator
1472                 $ui_comm see end
1473         }
1476 proc do_amend_last {} {
1477         load_last_commit
1480 proc do_commit {} {
1481         commit_tree
1484 # shift == 1: left click
1485 #          3: right click  
1486 proc click {w x y shift wx wy} {
1487         global ui_index ui_other
1489         set pos [split [$w index @$x,$y] .]
1490         set lno [lindex $pos 0]
1491         set col [lindex $pos 1]
1492         set path [$w get $lno.1 $lno.end]
1493         if {$path == {}} return
1495         if {$col > 0 && $shift == 1} {
1496                 $ui_index tag remove in_diff 0.0 end
1497                 $ui_other tag remove in_diff 0.0 end
1498                 $w tag add in_diff $lno.0 [expr $lno + 1].0
1499                 show_diff $path
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