1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300 301 302 303 304 305 306 307 308 309 310 311 312 313
|
set man(versiondiff) 1; set manx(versiondiff-v) {1 0}; set manx(versiondiff-t) {"yes" "no"}
set manx(edrx) {^(\d+),?(\d*)([adc])(\d+),?(\d*)$}
set manx(vdiff) $man(vdiff)
proc manVersionDiff {f w} {
global man manx
if {[string match "*/RCS/*,v" $f]} {
set rcsf $f
set dir [file dirname [file dirname $f]]
set tail [file tail $f]; set tail [string range $tail 0 [expr {[string length $tail]-3}]]
set f $dir/$tail
} elseif {[regexp {(.*)/(([^/]+)\.([^\.]+))} $f all dir tail rootname suffix]} {
set rcsf "$dir/RCS/$tail,v"
} else return
if {![file readable $rcsf]} {return ""}
# if {$manx(effcols) ne ""} {
set fid [open $manx(longtmp) "w"]; puts $fid ".ll $man(columns)\n.hym 20"; close $fid
# }
set cachedir $dir
if {[regsub {/man([^/]+)$} $dir {/cat\1} d2]} {set cachedir $d2}
append cachedir $manx(effcols)
if {![file writable $cachedir] && ![file writable [file dirname $cachedir]]} {
if {[regexp {^(/usr)?/(.*)man/man(.*)$} $dir all junk prefix suffix]} {
set cachedir "$man(fsstnddir)/${prefix}cat$suffix$manx(effcols)"
}
}
append cachedir "/RCSdiff"
set cachefile "$cachedir/$tail"
set existingcachefile [lfirst [glob -nocomplain "$cachefile$manx(zoptglob)"]]
if {[file readable $existingcachefile] && [file mtime $existingcachefile]>[file mtime $f] && [file mtime $existingcachefile]>[file mtime $rcsf] && [file mtime $existingcachefile]>$manx(mtime)} {
# use cache
# slightly different than manManPipe
if {[regexp $manx(zregexp) $existingcachefile]} {set pipe "|$man(zcat) "} else {set pipe ""}
set fid [open "$pipe$existingcachefile"]; set diffs [read $fid]; close $fid
#puts "using cached"
} else {
cursorBusy
cd $dir
manWinstdout $w "Computing diffs for $tail $manx(effcols) ..." 1
### find first version with changes (if any)
set search 1
set insym 0
set fid [open "|$man(rlog) $tail"]
while {$search && [gets $fid line]!=-1} {
if {!$insym} {
# look for "<ws>checkpoint: <rev>"
if {[regexp "^\[ \t\]+" $line]} {
if {[regexp "^\[ \t\]+checkpoint: (\[0-9\\.\]+)\$" $line all vnum]} {
set search 0
}
continue
} else {set insym 0}
# and fall through
}
if {[regexp {^revision ([\d\.]+)$} $line all vnum]} {
#puts "testing $vnum"
# gotta collect the stderr, ugh
catch {exec $man(rcsdiff) -r$vnum $tail} info
#puts "checking\n$info"
foreach line [split $info "\n"] {
if {[regexp $manx(edrx) $line]} {
#puts "match on $vnum"
set search 0; break
}
}
}
}
catch {close $fid}
# if !$isdiff {return ""} => even if no diff, cache this knowledge so faster next time
### collect diffs
# diff needs at least one of them to be a real file. want text of previous version around anyhow
set tmpf /tmp/tkman[pid]
# $man(changeleft) $man(zaphy) -- obsolete options
set format "$man(format) | $manx(rman) -f ASCII -N"
#puts "creating $tmpf (old)"
#puts "exec $man(co) -p$vnum $tail | $format > $tmpf"
catch {eval exec $man(co) -p$vnum $tail | $format > $tmpf} info
#puts "creating diffs vs v$vnum"
#puts $manx(vdiff)
# use "|open..." and read line at a time
catch {set diffs [eval exec [manManPipe $tail] | $format | $manx(vdiff) $tmpf -]} diffs
#puts $diffs
file delete -force $tmpf
# if {$manx(effcols) ne ""} {
file delete -force $manx(longtmp)
# }
# just save lines from old RCS file, as already have new lines!
# this works especially well as documents tend to grow
set newdiffs {}
set skip 0; set keep 0
set lines [split $diffs "\n"]
for {set linenum 0} {$linenum<[llength $lines]} {incr linenum} {
set line [lindex $lines $linenum]
if {$keep} {incr keep -1; append newdiffs [string range $line 2 end] "\n"; continue
} elseif {$skip} {incr skip -1; continue}
if {![regexp $manx(edrx) $line all n1 n2 cmd n3 n4]} break
if {$n2 eq ""} {set n2 $n1}; if {$n4 eq ""} {set n4 $n3}
set lcntold [expr {$n2-$n1+1}]; set lcntnew [expr {$n4-$n3+1}]
if {$cmd eq "a"} {
# already have added lines, throw them all out
set skip $lcntnew
append newdiffs "0a$lcntnew@$n3\n"
} elseif {$cmd eq "c"} {
# changed: keep old, skip separator and new
# first verify that changes aren't just formatting changes
# (not the same as diff's -B as formatting change may span lines)
set nrx "\[ \t\n|\]+"
set cold ""; set cnew ""
set i 0
for {set i 0} {$i<$lcntold} {incr i} {append cold [string range [lindex $lines [expr {$linenum+1+$i}]] 2 end] "\n"}
for {set i 0} {$i<$lcntnew} {incr i} {append cnew [string range [lindex $lines [expr {$linenum+1+$lcntold+1+$i}]] 2 end] "\n"}
regsub -all $nrx [string trim $cold] " " ncold
regsub -all $nrx [string trim $cnew] " " ncnew
if {$ncold ne $ncnew} {
#puts "diff: $ncold\n => $ncnew"
set keep $lcntold
set skip [expr {1+$lcntnew}]
append newdiffs "${lcntold}c$lcntnew@$n3\n"
} else {
#puts "bogus diff: $ncold"
incr linenum [expr {$lcntold+1+$lcntnew}]
}
} else { # d
# deleted from old, bring them along
set keep $lcntold
append newdiffs "${lcntold}c0@$n3\n"
}
}
set diffs $newdiffs
#puts $f\n$newdiffs
#puts $diffs
#exit 0
# cache diffs if possible
set writedir $cachedir
set mkdirs {}
while {![file exists $writedir]} {
lappend mkdirs $writedir
set writedir [file dirname $writedir]
}
if {[file writable $writedir]} {
foreach mkdir [lreverse $mkdirs] {file mkdir $mkdir}
}
#puts "$cachedir"
if {[file writable $cachedir]} {
if {[file writable $cachedir]} {
if {$existingcachefile ne ""} {file delete $existingcachefile}
#manWinstdout $w "Cacheing diffs ..." 1
set fid [open $cachefile "w"]; puts $fid $diffs; close $fid
catch {eval file delete [glob $cachefile.$manx(zglob)]}
eval exec $man(compress) $cachefile
} else {manTextPlug $w.show 1.0 "Couldn't cache version differences: $cachedir not writable" b}
}
cursorUnset
}
return $diffs
}
proc manVersionDiffMakeCache {w t} {
global mani manx man
manTextOpen $w
foreach sect $mani(manList) {
foreach dir $mani($sect,dirs) {
# dump this information info main window so can report "no RCS", "not writable", et cetera
$t insert end $dir b " "
set rcsdir "$dir/RCS"
set cachedir $dir
if {[regsub {/man([^/]+)$} [file dirname $dir] {/cat\1} d2]} {set cachedir $d2}
append cachedir $manx(effcols)
if {![file writable $cachedir] && ![file writable [file dirname $cachedir]]} {
if {[regexp {^(/usr)?/(.*)man/man(.*)$} $dir all junk prefix suffix]} {
set cachedir "$man(fsstnddir)/${prefix}cat$suffix$manx(effcols)"
}
}
append cachedir "/RCSdiff"
set writedir $cachedir
while {![file exists $writedir]} {set writedir [file dirname $writedir]}
set errmsg ""
if {![file exists $rcsdir]} {set errmsg "no versioning information (RCS directory)"
} elseif {![file readable $rcsdir]} {set errmsg "$rcsdir not readable"
} elseif {![file writable $writedir]} {set errmsg "$cachedir not writable/creatable (need perissions on $writedir)"
}
$t insert end "[expr {$errmsg==""?"CACHEING":$errmsg}]\n"
update idletasks; $t see end
if {$errmsg ne ""} continue
foreach rcsfile [lsort -dictionary [glob -nocomplain "$rcsdir/*,v"]] {
foreach cols $manx(columns-v) {
set tmp $manx(effcols); set manx(effcols) [expr {$cols==65?"":"@$cols"}]
manVersionDiff $rcsfile $w
set manx(effcols) $tmp
}
}
}
}
manTextClose $w
}
proc manVersion {w t f} {
global man manx
set diffcnt 0
if {[set diffs [manVersionDiff $f $w]] eq ""} {return $diffcnt}
set cmdrx {(\d+)([acd])(\d+)@(\d+)}
### apply diffs
set cmd XXX
set deltal 0; set atl 0
set dell 0
set tags ""
# invariant: start with command
# manOutline $t 0 *
foreach line [split $diffs "\n"] {
# if comparing paragraphs, try big chunk regions
if {$cmd eq "c" && $dell==1 && $dell0==1 && $man(columns)==5000} {
set dell 0
set newline [$t get $ts $ts+1l]
set startpre 0; if {[regexp -indices "^(\\|?\[ \t]+)" $newline indices]} {
set startpre [expr {1+[lsecond $indices]}]
set newline [string range $newline $startpre end]
}
$t delete "$ts linestart+${startpre}c" "$ts lineend"
eval $t insert "{$ts linestart+${startpre}c}" [textmanip::wdiff $line $newline]
foreach tag $tagshere {$t tag add $tag "$ts linestart" "$ts lineend"}
continue
}
# $t yview [expr $atl+$deltal].0-5l; update idletasks; after 1000
#puts "inspecting $line"
# lines deleted, which we recover (insert) now
if {$dell} {
# $t insert $ts "$line" $tags
# if {$dell ne $dell0} {$t insert "$ts lineend" "\n" $tags; incr deltal} else {incr atl}
$t insert $ts "|$line\n" $tags; incr deltal
set ts "[expr {$atl+$deltal}].0"
incr dell -1
continue
}
#puts "cmd? $line"
DEBUG { if {![regexp $cmdrx $line all dell cmd insl atl]} {puts "NO MATCH on\t$line"}}
if {![regexp $cmdrx $line all dell cmd insl atl]} break
set dell0 $dell
incr diffcnt
DEBUG {puts "applying $dell *$cmd* $insl @ $atl"}
set ts "[expr {$atl+$deltal}].0"
if {[regexp "a|c" $cmd]} {
# add tag to existing text
# if {!$insl} {set te $ts} else {set te "[expr $atl+$deltal+$insl].0"}
set te "[expr {$atl+$deltal+$insl}].0"
$t tag add diff$cmd $ts $te
for {set ci 0} {$ci<$insl} {incr ci} {
set cbi "[expr {$atl+$deltal+$ci}].0"
if {[$t get $cbi] eq ""} {append cbi "+1c"}; # skip over outline image
if {[$t get $cbi] ne "|"} {$t insert $cbi "|"}
}
#puts "$t tag add diff$cmd $ts $te"
}
if {[regexp "c|d" $cmd]} {
# insert old stuff, bump delta
# keep initial "<" as marker in left margin and as something for zapped newlines
set tagshere [$t tag names $ts]
set tags [concat [lmatches areajs* $tagshere] [lmatches elide $tagshere] diffd]
}
}
return $diffcnt
}
# zap everything in RCSdiff directories
proc manVersionClear {} {
global man manx
# doesn't respects settings in Paths
foreach dir $manx(paths) {
# if catman, may be only copy of page (SGI only has formatted)
if {[string match "*/catman*" $dir]} continue
# don't complain if can't write
catch {eval file delete -force [glob $dir/cat*/RCSdiff/*]}
catch {eval file delete -force [glob $dir/cat*/RCSdiff]}
}
# what about $man(fsstnddir)?
}
|