Git fork
1# git-gui object database management support
2# Copyright (C) 2006, 2007 Shawn Pearce
3
4proc do_stats {} {
5 set fd [git_read [list count-objects -v]]
6 while {[gets $fd line] > 0} {
7 if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
8 set stats($name) $value
9 }
10 }
11 close $fd
12
13 set packed_sz 0
14 foreach p [glob -directory [gitdir objects pack] \
15 -type f \
16 -nocomplain -- *] {
17 incr packed_sz [file size $p]
18 }
19 if {$packed_sz > 0} {
20 set stats(size-pack) [expr {$packed_sz / 1024}]
21 }
22
23 set w .stats_view
24 Dialog $w
25 wm withdraw $w
26 wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
27
28 ttk::frame $w.buttons
29 ttk::button $w.buttons.close -text [mc Close] \
30 -default active \
31 -command [list destroy $w]
32 ttk::button $w.buttons.gc -text [mc "Compress Database"] \
33 -default normal \
34 -command "destroy $w;do_gc"
35 pack $w.buttons.close -side right
36 pack $w.buttons.gc -side left
37 pack $w.buttons -side bottom -fill x -pady 10 -padx 10
38
39 ttk::labelframe $w.stat -text [mc "Database Statistics"]
40 foreach s {
41 {count {mc "Number of loose objects"}}
42 {size {mc "Disk space used by loose objects"} { KiB}}
43 {in-pack {mc "Number of packed objects"}}
44 {packs {mc "Number of packs"}}
45 {size-pack {mc "Disk space used by packed objects"} { KiB}}
46 {prune-packable {mc "Packed objects waiting for pruning"}}
47 {garbage {mc "Garbage files"}}
48 } {
49 set name [lindex $s 0]
50 set label [eval [lindex $s 1]]
51 if {[catch {set value $stats($name)}]} continue
52 if {[llength $s] > 2} {
53 set value "$value[lindex $s 2]"
54 }
55
56 ttk::label $w.stat.l_$name -text [mc "%s:" $label] -anchor w
57 ttk::label $w.stat.v_$name -text $value -anchor w
58 grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
59 }
60 pack $w.stat -pady 10 -padx 10
61
62 bind $w <Visibility> "grab $w; focus $w.buttons.close"
63 bind $w <Key-Escape> [list destroy $w]
64 bind $w <Key-Return> [list destroy $w]
65 wm title $w [mc "%s (%s): Database Statistics" [appname] [reponame]]
66 wm deiconify $w
67 tkwait window $w
68}
69
70proc do_gc {} {
71 set w [console::new {gc} [mc "Compressing the object database"]]
72 console::chain $w {
73 {exec git pack-refs --prune}
74 {exec git reflog expire --all}
75 {exec git repack -a -d -l}
76 {exec git rerere gc}
77 }
78}
79
80proc do_fsck_objects {} {
81 set w [console::new {fsck-objects} \
82 [mc "Verifying the object database with fsck-objects"]]
83 set cmd [list git fsck-objects]
84 lappend cmd --full
85 lappend cmd --cache
86 lappend cmd --strict
87 console::exec $w $cmd
88}
89
90proc hint_gc {} {
91 set ndirs 1
92 set limit 8
93 if {[is_Windows]} {
94 set ndirs 4
95 set limit 1
96 }
97
98 set count [llength [glob \
99 -nocomplain \
100 -- \
101 [gitdir objects 4\[0-[expr {$ndirs-1}]\]/*]]]
102
103 if {$count >= $limit * $ndirs} {
104 set objects_current [expr {$count * 256/$ndirs}]
105 if {[ask_popup \
106 [mc "This repository currently has approximately %i loose objects.
107
108To maintain optimal performance it is strongly recommended that you compress the database.
109
110Compress the database now?" $objects_current]] eq yes} {
111 do_gc
112 }
113 }
114}