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: df91d389d5 2007-09-04 aku: proc ::rcsparser::feedback {logcmd} { df91d389d5 2007-09-04 aku: variable lc $logcmd df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 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 {} df91d389d5 2007-09-04 aku: set res(size) [file size $path] df91d389d5 2007-09-04 aku: set res(done) 0 df91d389d5 2007-09-04 aku: set res(nsize) [string length $res(size)] df91d389d5 2007-09-04 aku: f166b0a63c 2007-08-31 aku: Admin f166b0a63c 2007-08-31 aku: Deltas f166b0a63c 2007-08-31 aku: Description f166b0a63c 2007-08-31 aku: DeltaTexts df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Feedback \r df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # Remove parser state df91d389d5 2007-09-04 aku: catch {unset res(id)} df91d389d5 2007-09-04 aku: catch {unset res(lastval)} df91d389d5 2007-09-04 aku: unset res(size) df91d389d5 2007-09-04 aku: unset res(nsize) df91d389d5 2007-09-04 aku: unset res(done) df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # res: 'head' -> head revision df91d389d5 2007-09-04 aku: # 'branch' -> ? df91d389d5 2007-09-04 aku: # 'symbol' -> (sym -> revision) df91d389d5 2007-09-04 aku: # 'lock' -> (sym -> revision) df91d389d5 2007-09-04 aku: # 'comment' -> file comment df91d389d5 2007-09-04 aku: # 'expand' -> ? df91d389d5 2007-09-04 aku: # 'date' -> (revision -> date) df91d389d5 2007-09-04 aku: # 'author' -> (revision -> author) df91d389d5 2007-09-04 aku: # 'state' -> (revision -> state) df91d389d5 2007-09-04 aku: # 'parent' -> (revision -> parent revision) df91d389d5 2007-09-04 aku: # 'commit' -> (revision -> commit message) df91d389d5 2007-09-04 aku: 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 df91d389d5 2007-09-04 aku: while {[Num 0]} { IsIdent ; 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 df91d389d5 2007-09-04 aku: while {[Num 0]} { IsIdent ; 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 \; df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: foreach {yr mo dy h m s} [split $res(lastval) .] break df91d389d5 2007-09-04 aku: if {$yr < 100} {incr yr 1900} df91d389d5 2007-09-04 aku: set res(lastval) [join [list $yr $mo $dy $h $m $s] .] df91d389d5 2007-09-04 aku: Map date 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 df91d389d5 2007-09-04 aku: Literal author ; Skip ; Literal \; ; Map author 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 df91d389d5 2007-09-04 aku: Literal state ; Skip ; Literal \; ; Map state 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 df91d389d5 2007-09-04 aku: Literal next ; Skip ; Literal \; ; Map parent 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 df91d389d5 2007-09-04 aku: 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: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 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 df91d389d5 2007-09-04 aku: regexp -indices -- {^\s*([^;]*)\s*} $data match val df91d389d5 2007-09-04 aku: Get $val 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) df91d389d5 2007-09-04 aku: #unset res(id);#Keep id for additional mappings. 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 {} { df91d389d5 2007-09-04 aku: upvar 1 match match data data res res f166b0a63c 2007-08-31 aku: foreach {s e} $match break ; incr e f166b0a63c 2007-08-31 aku: set data [string range $data $e end] df91d389d5 2007-09-04 aku: set res(done) [expr {$res(size) - [string length $data]}] df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: Feedback "\r [format "%$res(nsize)s" $res(done)]/$res(size) " df91d389d5 2007-09-04 aku: return df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: # ----------------------------------------------------------------------------- df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: namespace eval ::rcsparser { df91d389d5 2007-09-04 aku: variable lc ::rcs::Nop df91d389d5 2007-09-04 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::rcsparser::Feedback {text} { df91d389d5 2007-09-04 aku: variable lc df91d389d5 2007-09-04 aku: uplevel #0 [linsert $lc end info $text] f166b0a63c 2007-08-31 aku: return f166b0a63c 2007-08-31 aku: } df91d389d5 2007-09-04 aku: df91d389d5 2007-09-04 aku: proc ::rcsparser::Nop {args} {} 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
File Annotation