Merge commit '7c621da28f07e449ad90c387344f07a453927569' as 'tcllib'

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]]