f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: # -----------------------------------------------------------------------------
f166b0a63c 2007-08-31       aku: # Parse RCS files (,v) - ignore the deltas - we need only the commit messages
f166b0a63c 2007-08-31       aku: # Recursive Descent Parser
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: # -----------------------------------------------------------------------------
f166b0a63c 2007-08-31       aku: # Requirements
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: package require Tcl 8.4
f166b0a63c 2007-08-31       aku: package require fileutil ; # Tcllib (cat)
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: namespace eval ::rcsparser {}
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: # -----------------------------------------------------------------------------
f166b0a63c 2007-08-31       aku: # API
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::process {path} {
f166b0a63c 2007-08-31       aku:     set data [fileutil::cat -encoding binary $path]
f166b0a63c 2007-08-31       aku:     array set res {}
f166b0a63c 2007-08-31       aku:     Admin
f166b0a63c 2007-08-31       aku:     Deltas
f166b0a63c 2007-08-31       aku:     Description
f166b0a63c 2007-08-31       aku:     DeltaTexts
f166b0a63c 2007-08-31       aku:     return [array get res]
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: # -----------------------------------------------------------------------------
f166b0a63c 2007-08-31       aku: # Internal helper commands
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Admin {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Head ; Branch ; Access ; Symbols ; Locks ; Strict ; Comment ; Expand
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Deltas {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     while {[Num 0]} { Date ; Author ; State ; Branches ; NextRev }
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Description {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal desc
f166b0a63c 2007-08-31       aku:     String 1
f166b0a63c 2007-08-31       aku:     Def desc
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::DeltaTexts {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     while {[Num 0]} { Log ; Text }
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Head {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal head ; Num 1 ; Literal \;
f166b0a63c 2007-08-31       aku:     Def head
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Branch {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     if {![Literal branch 0]} return ; Num 1 ; Literal \;
f166b0a63c 2007-08-31       aku:     Def branch
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Access {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal access ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Symbols {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal symbols
f166b0a63c 2007-08-31       aku:     while {[Ident]} { Num 1 ; Map symbol }
f166b0a63c 2007-08-31       aku:     Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Locks {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal locks
f166b0a63c 2007-08-31       aku:     while {[Ident]} { Num 1 ; Map lock }
f166b0a63c 2007-08-31       aku:     Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Strict {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     if {![Literal strict 0]} return ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Comment {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     if {![Literal comment 0]} return ;
f166b0a63c 2007-08-31       aku:     if {![String 0]} return ;
f166b0a63c 2007-08-31       aku:     Literal \;
f166b0a63c 2007-08-31       aku:     Def comment
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Expand {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     if {![Literal expand 0]} return ;
f166b0a63c 2007-08-31       aku:     if {![String 0]} return ;
f166b0a63c 2007-08-31       aku:     Literal \;
f166b0a63c 2007-08-31       aku:     Def expand
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Date {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal date ; Num 1 ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Author {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal author ; Skip ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::State {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal state ; Skip ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Branches {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal branches ; Skip ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::NextRev {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal next ; Skip ; Literal \;
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Log {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     IsIdent ; Literal log ; String 1 ; Map commit
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Text {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     Literal text ; String 1
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Ident {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     #puts I@?<[string range $data 0 10]...>
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     if {[regexp -indices -- {^\s*;\s*} $data]} {
f166b0a63c 2007-08-31       aku: 	return 0
f166b0a63c 2007-08-31       aku:     } elseif {![regexp -indices -- {^\s*([^:]*)\s*:\s*} $data match val]} {
f166b0a63c 2007-08-31       aku: 	return 0
f166b0a63c 2007-08-31       aku:     }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     Get $val ; IsIdent
f166b0a63c 2007-08-31       aku:     Next
f166b0a63c 2007-08-31       aku:     return 1
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Literal {name {required 1}} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     if {![regexp -indices -- "^\\s*$name\\s*" $data match]} {
f166b0a63c 2007-08-31       aku: 	if {$required} {
f166b0a63c 2007-08-31       aku: 	    return -code error "Expected '$name' @ '[string range $data 0 30]...'"
f166b0a63c 2007-08-31       aku: 	}
f166b0a63c 2007-08-31       aku: 	return 0
f166b0a63c 2007-08-31       aku:     }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     Next
f166b0a63c 2007-08-31       aku:     return 1
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::String {{required 1}} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     if {![regexp -indices -- {^\s*@(([^@]*(@@)*)*)@\s*} $data match val]} {
f166b0a63c 2007-08-31       aku: 	if {$required} {
f166b0a63c 2007-08-31       aku: 	    return -code error "Expected string @ '[string range $data 0 30]...'"
f166b0a63c 2007-08-31       aku: 	}
f166b0a63c 2007-08-31       aku: 	return 0
f166b0a63c 2007-08-31       aku:     }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     Get $val
f166b0a63c 2007-08-31       aku:     Next
f166b0a63c 2007-08-31       aku:     return 1
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Num {required} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     if {![regexp -indices -- {^\s*((\d|\.)+)\s*} $data match val]} {
f166b0a63c 2007-08-31       aku: 	if {$required} {
f166b0a63c 2007-08-31       aku: 	    return -code error "Expected id @ '[string range $data 0 30]...'"
f166b0a63c 2007-08-31       aku: 	}
f166b0a63c 2007-08-31       aku: 	return 0
f166b0a63c 2007-08-31       aku:     }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku:     Get $val
f166b0a63c 2007-08-31       aku:     Next
f166b0a63c 2007-08-31       aku:     return 1
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Skip {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     regexp -indices -- {^\s*[^;]*\s*} $data match
f166b0a63c 2007-08-31       aku:     Next
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Def {key} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     set res($key) $res(lastval)
f166b0a63c 2007-08-31       aku:     unset res(lastval)
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Map {key} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     lappend res($key) $res(id) $res(lastval)
f166b0a63c 2007-08-31       aku:     #puts Map($res(id))=($res(lastval))
f166b0a63c 2007-08-31       aku:     unset res(lastval)
f166b0a63c 2007-08-31       aku:     unset res(id)
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::IsIdent {} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     set res(id) $res(lastval)
f166b0a63c 2007-08-31       aku:     unset res(lastval)
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Get {val} {
f166b0a63c 2007-08-31       aku:     upvar 1 data data res res
f166b0a63c 2007-08-31       aku:     foreach {s e} $val break
f166b0a63c 2007-08-31       aku:     set res(lastval) [string range $data $s $e]
f166b0a63c 2007-08-31       aku:     #puts G|$res(lastval)
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: proc ::rcsparser::Next {} {
f166b0a63c 2007-08-31       aku:     upvar 1 match match data data
f166b0a63c 2007-08-31       aku:     foreach {s e} $match break ; incr e
f166b0a63c 2007-08-31       aku:     set data [string range $data $e end]
f166b0a63c 2007-08-31       aku:     return
f166b0a63c 2007-08-31       aku: }
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: # -----------------------------------------------------------------------------
f166b0a63c 2007-08-31       aku: # Ready
f166b0a63c 2007-08-31       aku: 
f166b0a63c 2007-08-31       aku: package provide rcsparser 1.0
f166b0a63c 2007-08-31       aku: return