mirror of
https://github.com/git/git.git
synced 2024-06-02 21:06:29 +02:00
f522c9b5ed
I'm finding it difficult to work with a 6,000+ line Tcl script and not go insane while looking for a particular block of code. Since most of the program is organized into different units of functionality and not all users will need all units immediately on startup we can improve things by splitting procs out into multiple files and let auto_load handle things for us. This should help not only to better organize the source, but it may also improve startup times for some users as the Tcl parser does not need to read as much script before it can show the UI. In many cases the user can avoid reading at least half of git-gui now. Unfortunately we now need a library directory in our runtime location. This is currently assumed to be $(sharedir)/git-gui/lib and its expected that the Makefile invoker will setup some sort of reasonable sharedir value for us, or let us assume its going to be $(gitexecdir)/../share. We now also require a tclsh (in TCL_PATH) to just run the Makefile, as we use tclsh to generate the tclIndex for our lib directory. I'm hoping this is not an unncessary burden on end-users who are building from source. I haven't really made any functionality changes here, this is just a huge migration of code from one file to many smaller files. All of the new changes are to setup the library path and install the library files. Signed-off-by: Shawn O. Pearce <spearce@spearce.org>
90 lines
2.4 KiB
Tcl
90 lines
2.4 KiB
Tcl
# git-gui object database management support
|
|
# Copyright (C) 2006, 2007 Shawn Pearce
|
|
|
|
proc do_stats {} {
|
|
set fd [open "| git count-objects -v" r]
|
|
while {[gets $fd line] > 0} {
|
|
if {[regexp {^([^:]+): (\d+)$} $line _ name value]} {
|
|
set stats($name) $value
|
|
}
|
|
}
|
|
close $fd
|
|
|
|
set packed_sz 0
|
|
foreach p [glob -directory [gitdir objects pack] \
|
|
-type f \
|
|
-nocomplain -- *] {
|
|
incr packed_sz [file size $p]
|
|
}
|
|
if {$packed_sz > 0} {
|
|
set stats(size-pack) [expr {$packed_sz / 1024}]
|
|
}
|
|
|
|
set w .stats_view
|
|
toplevel $w
|
|
wm geometry $w "+[winfo rootx .]+[winfo rooty .]"
|
|
|
|
label $w.header -text {Database Statistics}
|
|
pack $w.header -side top -fill x
|
|
|
|
frame $w.buttons -border 1
|
|
button $w.buttons.close -text Close \
|
|
-default active \
|
|
-command [list destroy $w]
|
|
button $w.buttons.gc -text {Compress Database} \
|
|
-default normal \
|
|
-command "destroy $w;do_gc"
|
|
pack $w.buttons.close -side right
|
|
pack $w.buttons.gc -side left
|
|
pack $w.buttons -side bottom -fill x -pady 10 -padx 10
|
|
|
|
frame $w.stat -borderwidth 1 -relief solid
|
|
foreach s {
|
|
{count {Number of loose objects}}
|
|
{size {Disk space used by loose objects} { KiB}}
|
|
{in-pack {Number of packed objects}}
|
|
{packs {Number of packs}}
|
|
{size-pack {Disk space used by packed objects} { KiB}}
|
|
{prune-packable {Packed objects waiting for pruning}}
|
|
{garbage {Garbage files}}
|
|
} {
|
|
set name [lindex $s 0]
|
|
set label [lindex $s 1]
|
|
if {[catch {set value $stats($name)}]} continue
|
|
if {[llength $s] > 2} {
|
|
set value "$value[lindex $s 2]"
|
|
}
|
|
|
|
label $w.stat.l_$name -text "$label:" -anchor w
|
|
label $w.stat.v_$name -text $value -anchor w
|
|
grid $w.stat.l_$name $w.stat.v_$name -sticky we -padx {0 5}
|
|
}
|
|
pack $w.stat -pady 10 -padx 10
|
|
|
|
bind $w <Visibility> "grab $w; focus $w.buttons.close"
|
|
bind $w <Key-Escape> [list destroy $w]
|
|
bind $w <Key-Return> [list destroy $w]
|
|
wm title $w "[appname] ([reponame]): Database Statistics"
|
|
tkwait window $w
|
|
}
|
|
|
|
proc do_gc {} {
|
|
set w [new_console {gc} {Compressing the object database}]
|
|
console_chain {
|
|
{console_exec {git pack-refs --prune}}
|
|
{console_exec {git reflog expire --all}}
|
|
{console_exec {git repack -a -d -l}}
|
|
{console_exec {git rerere gc}}
|
|
} $w
|
|
}
|
|
|
|
proc do_fsck_objects {} {
|
|
set w [new_console {fsck-objects} \
|
|
{Verifying the object database with fsck-objects}]
|
|
set cmd [list git fsck-objects]
|
|
lappend cmd --full
|
|
lappend cmd --cache
|
|
lappend cmd --strict
|
|
console_exec $w $cmd console_done
|
|
}
|