diff options
author | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
---|---|---|
committer | William Joye <wjoye@cfa.harvard.edu> | 2016-10-27 19:39:39 (GMT) |
commit | ea28451286d3ea4a772fa174483f9a7a66bb1ab3 (patch) | |
tree | 6ee9d8a7848333a7ceeee3b13d492e40225f8b86 /tcllib/modules/bibtex | |
parent | b5ca09bae0d6a1edce939eea03594dd56383f2c8 (diff) | |
parent | 7c621da28f07e449ad90c387344f07a453927569 (diff) | |
download | blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.zip blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.gz blt-ea28451286d3ea4a772fa174483f9a7a66bb1ab3.tar.bz2 |
Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'
Diffstat (limited to 'tcllib/modules/bibtex')
-rw-r--r-- | tcllib/modules/bibtex/ChangeLog | 98 | ||||
-rw-r--r-- | tcllib/modules/bibtex/bibtex.man | 180 | ||||
-rw-r--r-- | tcllib/modules/bibtex/bibtex.pcx | 85 | ||||
-rw-r--r-- | tcllib/modules/bibtex/bibtex.tcl | 502 | ||||
-rw-r--r-- | tcllib/modules/bibtex/bibtex.test | 236 | ||||
-rw-r--r-- | tcllib/modules/bibtex/bytecode.bib | 6 | ||||
-rw-r--r-- | tcllib/modules/bibtex/penn_sub.bib | 11 | ||||
-rw-r--r-- | tcllib/modules/bibtex/pkgIndex.tcl | 2 |
8 files changed, 1120 insertions, 0 deletions
diff --git a/tcllib/modules/bibtex/ChangeLog b/tcllib/modules/bibtex/ChangeLog new file mode 100644 index 0000000..93764d2 --- /dev/null +++ b/tcllib/modules/bibtex/ChangeLog @@ -0,0 +1,98 @@ +2013-02-01 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.15 ======================== + * + +2011-12-13 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.14 ======================== + * + +2011-01-24 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.13 ======================== + * + +2009-12-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.12 ======================== + * + +2008-12-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11.1 ======================== + * + +2008-10-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.11 ======================== + * + +2008-06-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.pcx: New file. Syntax definitions for the public commands + of the bibtex package. + +2007-09-12 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.10 ======================== + * + +2007-03-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.man: Fixed all warnings due to use of now deprecated + commands. Added a section about how to give feedback. + +2006-10-03 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.9 ======================== + * + +2006-01-22 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.test: More boilerplate simplified via use of test support. + +2006-01-19 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.test: Hooked into the new common test support code. + +2005-10-06 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * + * Released and tagged Tcllib 1.8 ======================== + * + +2005-04-16 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * example.tcl: Moved out of the module into a new directory + 'bibtex/' under the examples tree. + +2005-03-14 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.test: Updated testsuite to handle the more rigorous + * bibtex.man: option processing, fixed some buglets. Added + * bibtex.tcl: a new API command and extended the documentation as + well. Bumped to version 0.5 + +2005-03-10 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.tcl: Revamped the option processing of 'parse', rewrote + processing to follow the documentation, and implemented true + background processing. ... Currently breaks the testsuite. + +2005-03-09 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.man: Added documentation. + +2005-03-07 Andreas Kupries <andreas_kupries@users.sourceforge.net> + + * bibtex.tcl: New module. Parser for BibTeX bibliography + * pkgIndex.tcl: files, by Neil Madden. diff --git a/tcllib/modules/bibtex/bibtex.man b/tcllib/modules/bibtex/bibtex.man new file mode 100644 index 0000000..c82b9b0 --- /dev/null +++ b/tcllib/modules/bibtex/bibtex.man @@ -0,0 +1,180 @@ +[comment {-*- tcl -*- doctools manpage}] +[vset VERSION 0.6] +[manpage_begin bibtex n [vset VERSION]] +[keywords bibliography] +[keywords bibtex] +[keywords parsing] +[keywords {text processing}] +[copyright {2005 for documentation, Andreas Kupries <andreas_kupries@users.sourceforge.net>}] +[moddesc {bibtex}] +[titledesc {Parse bibtex files}] +[category {Text processing}] +[require Tcl 8.4] +[require bibtex [opt [vset VERSION]]] +[description] +[para] + +This package provides commands for the parsing of bibliographies in +BibTeX format. + +[list_begin definitions] + +[call [cmd ::bibtex::parse] [opt [arg options]] [opt [arg text]]] + +This is the general form of the command for parsing a +bibliography. Depending on the options used to invoke it it will +either return a token for the parser, or the parsed entries of the +input bibliography. Instead of performing an immediate parse returning +a predefined format the command can also enter an event-based parsing +style where all relevant entries in the input are reported through +callback commands, in the style of SAX. + +[call [cmd ::bibtex::parse] [arg text]] + +In this form the command will assume that the specified [arg text] is +a bibliography in BibTeX format, parse it, and then return a list +containing one element per record found in the bibliography. Note that +comments, string definitions, preambles, etc. will not show up in the +result. Each element will be a list containing record type, +bibliography key and record data, in this order. The record data will +be a dictionary, its keys the keys of the record, with the associated +values. + +[call [cmd ::bibtex::parse] \ + [opt "[option -command] [arg cmd]"] \ + [option -channel] [arg chan]] + +In this form the command will reads the bibliography from the +specified Tcl channel [arg chan] and then returns the same data +structure as described above. + +[para] + +If however the option [option -command] is specified the result will be a +handle for the parser instead and all processing will be incremental +and happen in the background. When the input has been exhausted the +callback [arg cmd] will be invoked with the result of the parse. The +exact definition for the callback is + +[para] + +[list_begin definitions] +[def "[cmd cmd] [arg token] [arg parseresult]"] + +The parse result will have the structure explained above, for the +simpler forms of the parser. + +[list_end] +[para] + +[emph Note] that the parser will [emph not] close the channel after it +has exhausted it. This is still the responsibility of the user of the +parser. + +[call [cmd ::bibtex::parse] \ + [opt "[option -recordcommand] [arg recordcmd]"] \ + [opt "[option -preamblecommand] [arg preamblecmd]"] \ + [opt "[option -stringcommand] [arg stringcmd]"] \ + [opt "[option -commentcommand] [arg commentcmd]"] \ + [opt "[option -progresscommand] [arg progresscmd]"] \ + [opt "[option -casesensitivestrings] [arg bool]"] \ + "([arg text] | [option -channel] [arg chan])"] + +This is the most low-level form for the parser. The returned result +will be a handle for the parser. During processing it will invoke the +invoke the specified callback commands for each type of data found in +the bibliography. + +[para] + +The processing will be incremental and happen in the background if, +and only if a Tcl channel [arg chan] is specified. For a [arg text] +the processing will happen immediately and all callbacks will be +invoked before the command itself returns. + +[para] + +The callbacks, i.e. [arg *cmd], are all command prefixes and will be +invoked with additional arguments appended to them. The meaning of the +arguments depends on the callback and is explained below. The first +argument will however always be the handle of the parser invoking the +callback. + +[list_begin definitions] + +[def "[option -casesensitivestrings]"] + +This option takes a boolean value. When set string macro processing +becomes case-sensitive. The default is case-insensitive string macro +processing. + +[def "[cmd recordcmd] [arg token] [arg type] [arg key] [arg recorddict]"] + +This callback is invoked whenever the parser detects a bibliography +record in the input. Its arguments are the record type, the +bibliography key for the record, and a dictionary containing the keys +and values describing the record. Any string macros known to the +parser have already been expanded. + +[def "[cmd preamblecmd] [arg token] [arg preambletext]"] + +This callback is invoked whenever the parser detects an @preamble +block in the input. The only additional argument is the text found in +the preamble block. By default such entries are ignored. + +[def "[cmd stringcmd] [arg token] [arg stringdict]"] + +This callback is invoked whenever the parser detects an @string-based +macro definition in the input. The argument is a dictionary with the +macro names as keys and their replacement strings as values. By +default such definitions are added to the parser state for use in +future bibliography records. + +[def "[cmd commentcmd] [arg token] [arg commenttext]"] + +This callback is invoked whenever the parser detects a comment in the +input. The only additional argument is the comment text. By default +such entries are ignored. + +[def "[cmd progresscmd] [arg token] [arg percent]"] + +This callback is invoked during processing to tell the user about the +progress which has been made. Its argument is the percentage of data +processed, as integer number between [const 0] and [const 100]. + +In the case of incremental processing the perecentage will always be +[const -1] as the total number of entries is not known beforehand. + +[list_end] +[para] + +[call [cmd ::bibtex::wait] [arg token]] + +This command waits for the parser represented by the [arg token] to +complete and then returns. The returned result is the empty string. + +[call [cmd ::bibtex::destroy] [arg token]] + +This command cleans up all internal state associated with the parser +represented by the handle [arg token], effectively destroying it. This +command can be called from within the parser callbacks to terminate +processing. + +[call [cmd ::bibtex::addStrings] [arg token] [arg stringdict]] + +This command adds the macro definitions stored in the +dictionary [arg stringdict] to the parser represented +by the handle [arg token]. + +[para] + +The dictionary keys are the macro names and the values their +replacement strings. This command has the correct signature for use as +a [option -stringcommand] callback in an invokation of the command +[cmd ::bibtex::parse]. + +[list_end] + +[vset CATEGORY bibtex] +[include ../doctools2base/include/feedback.inc] +[manpage_end] diff --git a/tcllib/modules/bibtex/bibtex.pcx b/tcllib/modules/bibtex/bibtex.pcx new file mode 100644 index 0000000..2486dc3 --- /dev/null +++ b/tcllib/modules/bibtex/bibtex.pcx @@ -0,0 +1,85 @@ +# -*- tcl -*- bibtex.pcx +# Syntax of the commands provided by package bibtex. +# +# For use by TclDevKit's static syntax checker (v4.1+). +# See http://www.activestate.com/solutions/tcl/ +# See http://aspn.activestate.com/ASPN/docs/Tcl_Dev_Kit/4.0/Checker.html#pcx_api +# for the specification of the format of the code in this file. +# + +package require pcx +pcx::register bibtex +pcx::tcldep 0.5 needs tcl 8.5 +pcx::tcldep 0.6 needs tcl 8.5 + +namespace eval ::bibtex {} + +pcx::message parseSaxCmdErr {Options -*command and -command exclude each other} err + +pcx::check 0.5 std ::bibtex::addStrings \ + {checkSimpleArgs 2 2 { + checkWord + checkDict + }} +pcx::check 0.5 std ::bibtex::destroy \ + {checkSimpleArgs 1 1 { + checkWord + }} +pcx::check 0.5 std ::bibtex::parse \ + {checkSimpleArgs 1 -1 { + {checkConstrained { + checkSwitches exact { + {-recordcommand {checkSetConstraint sax {checkProcCall 4}}} + {-preamblecommand {checkSetConstraint sax {checkProcCall 2}}} + {-stringcommand {checkSetConstraint sax {checkProcCall 2}}} + {-commentcommand {checkSetConstraint sax {checkProcCall 2}}} + {-progresscommand {checkSetConstraint sax {checkProcCall 2}}} + {-command {checkSetConstraint cmd {checkProcCall 2}}} + {-channel {checkSetConstraint chan checkChannelID}} + } {checkConstraint { + {{chan sax cmd} {warn bibtex::parseSaxCmdErr {} checkAtEnd}} + {{sax cmd} {warn bibtex::parseSaxCmdErr {} { + checkSimpleArgs 1 1 { + checkWord + } + }}} + {chan checkAtEnd} + } {checkSimpleArgs 1 1 { + checkWord + }}} + }} + }} +pcx::check 0.5 std ::bibtex::wait \ + {checkSimpleArgs 1 1 { + checkWord + }} + +pcx::check 0.6 std ::bibtex::parse \ + {checkSimpleArgs 1 -1 { + {checkConstrained { + checkSwitches exact { + {-casesensitivestrings checkBoolean} + {-recordcommand {checkSetConstraint sax {checkProcCall 4}}} + {-preamblecommand {checkSetConstraint sax {checkProcCall 2}}} + {-stringcommand {checkSetConstraint sax {checkProcCall 2}}} + {-commentcommand {checkSetConstraint sax {checkProcCall 2}}} + {-progresscommand {checkSetConstraint sax {checkProcCall 2}}} + {-command {checkSetConstraint cmd {checkProcCall 2}}} + {-channel {checkSetConstraint chan checkChannelID}} + } {checkConstraint { + {{chan sax cmd} {warn bibtex::parseSaxCmdErr {} checkAtEnd}} + {{sax cmd} {warn bibtex::parseSaxCmdErr {} { + checkSimpleArgs 1 1 { + checkWord + } + }}} + {chan checkAtEnd} + } {checkSimpleArgs 1 1 { + checkWord + }}} + }} + }} + +# Initialization via pcx::init. +# Use a ::bibtex::init procedure for non-standard initialization. +pcx::complete diff --git a/tcllib/modules/bibtex/bibtex.tcl b/tcllib/modules/bibtex/bibtex.tcl new file mode 100644 index 0000000..033a0dc --- /dev/null +++ b/tcllib/modules/bibtex/bibtex.tcl @@ -0,0 +1,502 @@ +##### +# +# "BibTeX parser" +# http://wiki.tcl.tk/13719 +# +# Tcl code harvested on: 7 Mar 2005, 23:55 GMT +# Wiki page last updated: ??? +# +##### + +# bibtex.tcl -- +# +# A basic parser for BibTeX bibliography databases. +# +# Copyright (c) 2005 Neil Madden. +# Copyright (c) 2005 Andreas Kupries. +# License: Tcl/BSD style. + +### NOTES +### +### Need commands to introspect parser state. Especially the string +### map (for testing of 'addStrings', should be useful in general as +### well). + +# ### ### ### ######### ######### ######### +## Requisites + +package require Tcl 8.4 +package require cmdline + +# ### ### ### ######### ######### ######### +## Implementation: Public API + +namespace eval ::bibtex {} + +# bibtex::parse -- +# +# Parse a bibtex file. +# +# parse ?options? ?bibtex? + +proc ::bibtex::parse {args} { + variable data + variable id + + # Argument processing + if {[llength $args] < 1} { + set err "[lindex [info level 0] 0] ?options? ?bibtex?" + return -code error "wrong # args: should be \"$err\"" + } + + array set state {} + GetOptions $args state + + # Initialize the parser state from the options, fill in default + # values, and handle the input according the specified mode. + + set token bibtex[incr id] + foreach {k v} [array get state] { + set data($token,$k) $v + } + + if {$state(stream)} { + # Text not in memory + if {!$state(bg)} { + # Text from a channel, no async processing. We read everything + # into memory and the handle it as before. + + set blockmode [fconfigure $state(-channel) -blocking] + fconfigure $state(-channel) -blocking 1 + set data($token,buffer) [read $state(-channel)] + fconfigure $state(-channel) -blocking $blockmode + + # Tell upcoming processing that the text is in memory. + set state(stream) 0 + } else { + # Text from a channel, and processing is async. Create an + # event handler for the incoming data. + + set data($token,done) 0 + fileevent $state(-channel) readable \ + [list ::bibtex::ReadChan $token] + + # Initialize the parser internal result buffer if we use plain + # -command, and not the SAX api. + if {!$state(sax)} { + set data($token,result) {} + } + } + } + + # Initialize the string mappings (none known), and the result + # accumulator. + set data($token,strings) {} + set data($token,result) {} + + if {!$state(stream)} { + ParseRecords $token 1 + if {$state(sax)} { + set result $token + } else { + set result $data($token,result) + destroy $token + } + return $result + } + + # Assert: Processing is in background. + return $token +} + +# Cleanup a parser, cancelling any callbacks etc. + +proc ::bibtex::destroy {token} { + variable data + + if {![info exists data($token,stream)]} { + return -code error "Illegal bibtex parser \"$token\"" + } + if {$data($token,stream)} { + fileevent $data($token,-channel) readable {} + } + + array unset data $token,* + return +} + + +proc ::bibtex::wait {token} { + variable data + + if {![info exists data($token,stream)]} { + return -code error "Illegal bibtex parser \"$token\"" + } + vwait ::bibtex::data($token,done) + return +} + +# bibtex::addStrings -- +# +# Add strings to the map for a particular parser. All strings are +# expanded at parse time. + +proc ::bibtex::addStrings {token strings} { + variable data + eval [linsert $strings 0 lappend data($token,strings)] + return +} + +# ### ### ### ######### ######### ######### +## Implementation: Private utility routines + +proc ::bibtex::AddRecord {token type key recdata} { + variable data + lappend data($token,result) [list $type $key $recdata] + return +} + +proc ::bibtex::GetOptions {argv statevar} { + upvar 1 $statevar state + + # Basic processing of the argument list + # and the options found therein. + + set opts [lrange [::cmdline::GetOptionDefaults { + {command.arg {}} + {channel.arg {}} + {recordcommand.arg {}} + {preamblecommand.arg {}} + {stringcommand.arg {}} + {commentcommand.arg {}} + {progresscommand.arg {}} + {casesensitivestrings.arg {}} + } result] 2 end] ;# Remove ? and help. + + set argc [llength $argv] + while {[set err [::cmdline::getopt argv $opts opt arg]]} { + if {$err < 0} { + set olist "" + foreach o [lsort $opts] { + if {[string match *.arg $o]} { + set o [string range $o 0 end-4] + } + lappend olist -$o + } + return -code error "bad option \"$opt\",\ + should be one of\ + [linsert [join $olist ", "] end-1 or]" + } + set state(-$opt) $arg + } + + # Check the information gained so far + # for inconsistencies and/or missing + # pieces. + + set sax [expr { + [info exists state(-recordcommand)] || + [info exists state(-preamblecommand)] || + [info exists state(-stringcommand)] || + [info exists state(-commentcommand)] || + [info exists state(-progresscommand)] + }] ; # {} + + set bg [info exists state(-command)] + + if {$sax && $bg} { + # Sax callbacks and channel completion callback exclude each + # other. + return -code error "The options -command and -TYPEcommand exclude each other" + } + + set stream [info exists state(-channel)] + + if {$stream} { + # Channel is present, a text is not allowed. + if {[llength $argv]} { + return -code error "Option -channel and text exclude each other" + } + + # The channel has to exist as well. + if {[lsearch -exact [file channels] $state(-channel)] < 0} { + return -code error "Illegal channel handle \"$state(-channel)\"" + } + } else { + # Channel is not present, we have to have a text, and only + # exactly one. And a general -command callback is not allowed. + + if {![llength $argv]} { + return -code error "Neither -channel nor text specified" + } elseif {[llength $argv] > 1} { + return -code error "wrong # args: [lindex [info level 1] 0] ?options? ?bibtex?" + } + + # Channel completion callback is not allowed if we are not + # reading from a channel. + + if {$bg} { + return -code error "Option -command and text exclude each other" + } + + set state(buffer) [lindex $argv 0] + } + + set state(stream) $stream + set state(sax) $sax + set state(bg) [expr {$sax || $bg}] + + if {![info exists state(-stringcommand)]} { + set state(-stringcommand) [list ::bibtex::addStrings] + } + if {![info exists state(-recordcommand)] && (!$sax)} { + set state(-recordcommand) [list ::bibtex::AddRecord] + } + if {[info exists state(-casesensitivestrings)] && + $state(-casesensitivestrings) + } { + set state(casesensitivestrings) 1 + } else { + set state(casesensitivestrings) 0 + } + return +} + +proc ::bibtex::Callback {token type args} { + variable data + + #puts stdout "Callback ($token $type ($args))" + + if {[info exists data($token,-${type}command)]} { + eval $data($token,-${type}command) [linsert $args 0 $token] + } + return +} + +proc ::bibtex::ReadChan {token} { + variable data + + # Read the waiting characters into our buffer and process + # them. The records are saved either through a user supplied + # record callback, or the standard callback for our non-sax + # processing. + + set chan $data($token,-channel) + append data($token,buffer) [read $chan] + + if {[eof $chan]} { + # Final processing. In non-SAX mode we have to deliver the + # completed result before destroying the parser. + + ParseRecords $token 1 + set data($token,done) 1 + if {!$data($token,sax)} { + Callback $token {} $data($token,result) + } + return + } + + # Processing of partial data. + + ParseRecords $token 0 + return +} + +proc ::bibtex::Tidy {str} { + return [string tolower [string trim $str]] +} + +proc ::bibtex::ParseRecords {token eof} { + # A rough BibTeX grammar (case-insensitive): + # + # Database ::= (Junk '@' Entry)* + # Junk ::= .*? + # Entry ::= Record + # | Comment + # | String + # | Preamble + # Comment ::= "comment" [^\n]* \n -- ignored + # String ::= "string" '{' Field* '}' + # Preamble ::= "preamble" '{' .* '}' -- (balanced) + # Record ::= Type '{' Key ',' Field* '}' + # | Type '(' Key ',' Field* ')' -- not handled + # Type ::= Name + # Key ::= Name + # Field ::= Name '=' Value + # Name ::= [^\s\"#%'(){}]* + # Value ::= [0-9]+ + # | '"' ([^'"']|\\'"')* '"' + # | '{' .* '}' -- (balanced) + + # " - Fixup emacs hilit confusion from the grammar above. + variable data + set bibtex $data($token,buffer) + + # Split at each @ character which is at the beginning of a line, + # modulo whitespace. This is a heuristic to distinguish the @'s + # starting a new record from the @'s occuring inside a record, as + # part of email addresses. Empty pices at beginning or end are + # stripped before the split. + + regsub -line -all {^[\n\r\f\t ]*@} $bibtex \000 bibtex + set db [split [string trim $bibtex \000] \000] + + if {$eof} { + set total [llength $db] + set step [expr {double($total) / 100.0}] + set istep [expr {$step > 1 ? int($step) : 1}] + set count 0 + } else { + if {[llength $db] < 2} { + # Nothing to process, or data which ay be incomplete. + return + } + + set data($token,buffer) [lindex $db end] + set db [lrange $db 0 end-1] + + # Fake progress meter. + set count -1 + } + + foreach block $db { + if {$count < 0} { + Callback $token progress -1 + } elseif {([incr count] % $istep) == 0} { + Callback $token progress [expr {int($count / $step)}] + } + if {[regexp -nocase {\s*comment([^\n])*\n(.*)} $block \ + -> cmnt rest]} { + # Are @comments blocks, or just 1 line? + # Does anyone care? + Callback $token comment $cmnt + + } elseif {[regexp -nocase {^\s*string[^\{]*\{(.*)\}[^\}]*} \ + $block -> rest]} { + # string macro defs + if {$data($token,casesensitivestrings)} { + Callback $token string [ParseString $rest] + } else { + Callback $token string [ParseBlock $rest] + } + } elseif {[regexp -nocase {\s*preamble[^\{]*\{(.*)\}[^\}]*} \ + $block -> rest]} { + Callback $token preamble $rest + + } elseif {[regexp {([^\{]+)\{([^,]*),(.*)\}[^\}]*} \ + $block -> type key rest]} { + # Do any @string mappings + if {$data($token,casesensitivestrings)} { + # puts $data($token,strings) + set rest [string map $data($token,strings) $rest] + } else { + set rest [string map -nocase $data($token,strings) $rest] + } + Callback $token record [Tidy $type] [string trim $key] \ + [ParseBlock $rest] + } else { + ## FUTURE: Use a logger. + puts stderr "Skipping: $block" + } + } +} + +proc ::bibtex::ParseString {block} { + regexp {(\S+)[^=]*=(.*)} $block -> key rest + return [list $key $rest] +} + +proc ::bibtex::ParseBlock {block} { + set ret [list] + set index 0 + while { + [regexp -start $index -indices -- \ + {(\S+)[^=]*=(.*)} $block -> key rest] + } { + foreach {ks ke} $key break + set k [Tidy [string range $block $ks $ke]] + foreach {rs re} $rest break + foreach {v index} \ + [ParseBibString $rs [string range $block $rs $re]] \ + break + lappend ret $k $v + } + return $ret +} + +proc ::bibtex::ParseBibString {index str} { + set count 0 + set retstr "" + set escape 0 + set string 0 + foreach char [split $str ""] { + incr index + if {$escape} { + set escape 0 + } else { + if {$char eq "\{"} { + incr count + continue + } elseif {$char eq "\}"} { + incr count -1 + if {$count < 0} {incr index -1; break} + continue + } elseif {$char eq ","} { + if {$count == 0} break + } elseif {$char eq "\\"} { + set escape 1 + continue + } elseif {$char eq "\""} { + # Managing the count ensures that comma inside of a + # string is not considered as the end of the field. + if {!$string} { + incr count + set string 1 + } else { + incr count -1 + set string 0 + } + continue + } + # else: Nothing + } + append retstr $char + } + regsub -all {\s+} $retstr { } retstr + return [list [string trim $retstr] $index] +} + + +# ### ### ### ######### ######### ######### +## Internal. Package configuration and state. + +namespace eval bibtex { + # Counter for the generation of parser tokens. + variable id 0 + + # State of all parsers. Keys for each parser are prefixed with the + # parser token. + variable data + array set data {} + + # Keys and their meaning (listed without token prefix) + ## + # buffer + # eof + # channel <-\/- Difference ? + # strings | + # -async | + # -blocksize | + # -channel <-/ + # -recordcommand -- callback for each record + # -preamblecommand -- callback for @preamble blocks + # -stringcommand -- callback for @string macros + # -commentcommand -- callback for @comment blocks + # -progresscommand -- callback to indicate progress of parse + ## +} + +# ### ### ### ######### ######### ######### +## Ready to go +package provide bibtex 0.6 +# EOF diff --git a/tcllib/modules/bibtex/bibtex.test b/tcllib/modules/bibtex/bibtex.test new file mode 100644 index 0000000..aa84594 --- /dev/null +++ b/tcllib/modules/bibtex/bibtex.test @@ -0,0 +1,236 @@ +# -*- tcl -*- +# bibtex.test: tests for the bibtex parser. +# +# Copyright (c) 2005 by Andreas Kupries <a.kupries@westend.com> +# All rights reserved. +# +# RCS: @(#) $Id: bibtex.test,v 1.7 2006/10/09 21:41:40 andreas_kupries Exp $ + +# ------------------------------------------------------------------------- + +source [file join \ + [file dirname [file dirname [file join [pwd] [info script]]]] \ + devtools testutilities.tcl] + +testsNeedTcl 8.4 +testsNeedTcltest 1.0 + +testing { + useLocal bibtex.tcl bibtex +} + +# ------------------------------------------------------------------------- + +proc track {args} {global track ; lappend track $args ; return} +proc addstr {token strings} { + track string__ $token $strings + bibtex::addStrings $token $strings +} + +# ------------------------------------------------------------------------- + +test bibtex-1.0 {Parse errors} { + set code [catch {::bibtex::parse} msg] + list $code $msg +} {1 {wrong # args: should be "::bibtex::parse ?options? ?bibtex?"}} + +test bibtex-1.1 {Parse errors} {} { + set code [catch {::bibtex::parse -frob} msg] + list $code $msg +} {1 {bad option "frob", should be one of -casesensitivestrings, -channel, -command, -commentcommand, -preamblecommand, -progresscommand, -recordcommand, or -stringcommand}} + +test bibtex-1.2 {Parse errors} { + set code [catch {::bibtex::parse -frob nibar} msg] + list $code $msg +} {1 {bad option "frob", should be one of -casesensitivestrings, -channel, -command, -commentcommand, -preamblecommand, -progresscommand, -recordcommand, or -stringcommand}} + +test bibtex-1.3 {Parse errors} {} { + set code [catch {::bibtex::parse -frob nibar fuzz} msg] + list $code $msg +} {1 {bad option "frob", should be one of -casesensitivestrings, -channel, -command, -commentcommand, -preamblecommand, -progresscommand, -recordcommand, or -stringcommand}} + +test bibtex-1.4 {Parse errors} {} { + set code [catch {::bibtex::parse -command nibar -recordcommand fuzz snarf} msg] + list $code $msg +} {1 {The options -command and -TYPEcommand exclude each other}} + +test bibtex-1.5 {Parse errors} {} { + set code [catch {::bibtex::parse -channel nibar snarf} msg] + list $code $msg +} {1 {Option -channel and text exclude each other}} + +test bibtex-1.6 {Parse errors} {} { + set code [catch {::bibtex::parse -channel nibar} msg] + list $code $msg +} {1 {Illegal channel handle "nibar"}} + +test bibtex-1.7 {Parse errors} {} { + set code [catch {::bibtex::parse -command nibar} msg] + list $code $msg +} {1 {Neither -channel nor text specified}} + +test bibtex-1.8 {Parse errors} {} { + set code [catch {::bibtex::parse -command nibar fuzz snarf} msg] + list $code $msg +} {1 {wrong # args: ::bibtex::parse ?options? ?bibtex?}} + +test bibtex-1.9 {Parse errors} {} { + set code [catch {::bibtex::parse -command nibar fuzz} msg] + list $code $msg +} {1 {Option -command and text exclude each other}} + + +# ------------------------------------------------------------------------- + +set bytecode [list [list \ + book krasner83 [list \ + title {Smalltalk-80: Bits of History, Words of Advice} \ + publisher Addison-Wesley \ + year 1983 \ + editor {Glen Krasner} \ + ]]] + +set penn [list [list \ + inproceedings Carberry90 [list \ + author {Sandra Carberry} \ + title {Incorporating default inferences into plan recognition} \ + booktitle aaai90 \ + year 1990 \ + pages 471--478 \ + address {Boston, MA} \ + ]]] + +set pennfull [list [list \ + inproceedings Carberry90 [list \ + author {Sandra Carberry} \ + title {Incorporating default inferences into plan recognition} \ + booktitle {Proc. National Conference on Artificial Intelligence, Boston} \ + year 1990 \ + pages 471--478 \ + address {Boston, MA} \ + ]]] + + +test bibtex-2.0 {Parse string, direct result} { + set str [viewFile [file join [file dirname [info script]] bytecode.bib]] + bibtex::parse $str +} $bytecode + +test bibtex-2.1 {Parse string, sax mode} { + set track {} + set str [viewFile [file join [file dirname [info script]] bytecode.bib]] + set t [bibtex::parse \ + -progresscommand {track progress} \ + -commentcommand {track comment_} \ + -stringcommand {track string__} \ + -preamblecommand {track preamble} \ + -recordcommand {track record__} \ + $str] + bibtex::destroy $t + list $t $track +} [list bibtex2 [list \ + {progress bibtex2 100} \ + [linsert [lindex $bytecode 0] 0 record__ bibtex2] +]] + +test bibtex-2.2 {Parse channel, direct result} { + # The contents of penn_sub.bib have been taken out of + # ftp://ftp.cis.upenn.edu/pub/anoop/bib/pennbib.bib + + set chan [open [file join [file dirname [info script]] penn_sub.bib] r] + set records [bibtex::parse -channel $chan] + close $chan + set records +} $pennfull + +test bibtex-2.3 {Parse channel, sax mode} { + set track {} + set chan [open [file join [file dirname [info script]] penn_sub.bib] r] + + set t [bibtex::parse \ + -progresscommand {track progress} \ + -commentcommand {track comment_} \ + -stringcommand {track string__} \ + -preamblecommand {track preamble} \ + -recordcommand {track record__} \ + -channel $chan] + bibtex::wait $t + bibtex::destroy $t + + close $chan + set track +} [list \ + {progress bibtex4 50} \ + {string__ bibtex4 {aaai90 {Proc. National Conference on Artificial Intelligence, Boston}}} \ + {progress bibtex4 100} \ + [linsert [lindex $penn 0] 0 record__ bibtex4] \ + ] + +test bibtex-2.4 {Parse channel, sax mode 2} { + set track {} + set chan [open [file join [file dirname [info script]] penn_sub.bib] r] + + set t [bibtex::parse \ + -progresscommand {track progress} \ + -commentcommand {track comment_} \ + -stringcommand addstr \ + -preamblecommand {track preamble} \ + -recordcommand {track record__} \ + -channel $chan] + bibtex::wait $t + bibtex::destroy $t + close $chan + set track +} [list \ + {progress bibtex5 50} \ + {string__ bibtex5 {aaai90 {Proc. National Conference on Artificial Intelligence, Boston}}} \ + {progress bibtex5 100} \ + [linsert [lindex $pennfull 0] 0 record__ bibtex5] \ + ] + +test bibtex-2.5 {Parse channel, async} { + # The contents of penn_sub.bib have been taken out of + # ftp://ftp.cis.upenn.edu/pub/anoop/bib/pennbib.bib + + set chan [open [file join [file dirname [info script]] penn_sub.bib] r] + proc done {args} {global done ; set done $args ; return} + + set done "" + set t [bibtex::parse -command done -channel $chan] + vwait ::done + bibtex::destroy $t + close $chan + set done +} [list bibtex6 $pennfull] + + +test bibtex-3.0 {Destroying a parser} { + set code [catch {::bibtex::destroy} msg] + list $code $msg +} [list 1 [tcltest::wrongNumArgs "::bibtex::destroy" "token" 0]] + +test bibtex-3.1 {Destroying a parser} { + set code [catch {::bibtex::destroy a b} msg] + list $code $msg +} [list 1 [tcltest::tooManyArgs "::bibtex::destroy" "token"]] + +test bibtex-3.2 {Destroying a parser} { + set code [catch {::bibtex::destroy foo} msg] + list $code $msg +} {1 {Illegal bibtex parser "foo"}} + +test bibtex-4.0 {Destroying a parser} { + + set chan [open [file join [file dirname [info script]] bytecode.bib] r] + proc done {args} {global done ; set done $args ; return} + + set done "" + set t [bibtex::parse -command done -channel $chan] + bibtex::destroy $t + close $chan +} {} + +# ... Tests of addStrings ... +# (Requires introspection of parser state) + +testsuiteCleanup diff --git a/tcllib/modules/bibtex/bytecode.bib b/tcllib/modules/bibtex/bytecode.bib new file mode 100644 index 0000000..0f7409d --- /dev/null +++ b/tcllib/modules/bibtex/bytecode.bib @@ -0,0 +1,6 @@ +@Book{krasner83, + title = "Smalltalk-80: Bits of History, Words of Advice", + publisher = "Addison-Wesley", + year = 1983, + editor = "Glen Krasner" +} diff --git a/tcllib/modules/bibtex/penn_sub.bib b/tcllib/modules/bibtex/penn_sub.bib new file mode 100644 index 0000000..4cd6a3f --- /dev/null +++ b/tcllib/modules/bibtex/penn_sub.bib @@ -0,0 +1,11 @@ +@String{aaai90 = "Proc. National Conference on Artificial Intelligence, + Boston"} +@InProceedings{Carberry90, + author = "Sandra Carberry", + title = "Incorporating default inferences into plan + recognition", + booktitle = "aaai90", + year = "1990", + pages = "471--478", + address = "Boston, MA", +} diff --git a/tcllib/modules/bibtex/pkgIndex.tcl b/tcllib/modules/bibtex/pkgIndex.tcl new file mode 100644 index 0000000..5c2ccf1 --- /dev/null +++ b/tcllib/modules/bibtex/pkgIndex.tcl @@ -0,0 +1,2 @@ +if {![package vsatisfies [package provide Tcl] 8.4]} {return} +package ifneeded bibtex 0.6 [list source [file join $dir bibtex.tcl]] |