Tcl Library Source Code

[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 <[email protected]>}]
[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 "[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.

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

# -*- 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 {

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

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

    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

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

    # -commentcommand  -- callback for @comment blocks
    # -progresscommand -- callback to indicate progress of parse
    ##
}

# ### ### ### ######### ######### #########
## Ready to go
package provide bibtex 0.6
# EOF

if {![package vsatisfies [package provide Tcl] 8.4]} {return}
package ifneeded bibtex 0.6 [list source [file join $dir bibtex.tcl]]