# $Id$
$VERSION{''.__FILE__} = '$Revision$';
#
# >>Title::     Simple Document Format Library
#
# >>Copyright::
# Copyright (c) 1992-1996, Ian Clatworthy (ianc@mincom.com).
# You may distribute under the terms specified in the LICENSE file.
#
# >>History::
# -----------------------------------------------------------------------
# Date      Who     Change
# 29-Feb-96 ianc    SDF 2.000
# -----------------------------------------------------------------------
#
# >>Purpose::
# This library provides support for handling
# [[SDF]] files.
#
# >>Description::
# The following symbols are occasionally accessed from other modules
# but aren't really for public consumption:
#
# {{Y:SDF_IMAGE_EXTS}}, 
# {{Y:sdf_if_start}}, 
# {{Y:sdf_if_now}}, 
# {{Y:sdf_if_yet}}, 
# {{Y:sdf_if_else}}, 
# {{Y:sdf_block_start}}, 
# {{Y:sdf_block_type}}, 
# {{Y:sdf_block_text}}, 
# {{Y:sdf_block_param}}, 
# {{Y:sdf_tbl_start}}, 
# {{Y:sdf_tbl_state}}, 
# {{Y:sdf_end}}, 
# {{Y:sdf_cutting}}, 
# {{Y:sdf_sections}}, 
# {{Y:sdf_book_files}}, 
# {{Y:sdf_report_names}}, 
# {{Y:SdfSystem}}, 
# {{Y:SdfBatch}}, 
# {{Y:SdfDelete}}, 
# {{Y:SdfBookClean}}, 
# {{Y:SdfRenamePS}}.
#
# >>Limitations::
# Append/Prepend is not implemented for macros - is
# it needed for them?
#
# {{Y:SdfBookConvert}} currently generates (Unix) shell scripts.
# It should be generalised to support other operating systems?
#
# >>Resources::
#
# >>Implementation::
#

require "sdf/macros.pl";
require "sdf/podmacs.pl";
require "sdf/filters.pl";
require "sdf/specials.pl";
require "sdf/values.pl";
require "sdf/subs.pl";
require "sdf/calc.pl";

require Config;

##### Constants #####

# This should arguably be distributed into each driver.
# (At the moment, FindFile() defaults to ps if a target isn't found.)
%SDF_IMAGE_EXTS = (
        'ps'   => ['epsi', 'eps', 'wmf', 'mif', 'gif'],
        'html' => ['jpeg', 'jpg', 'png', 'gif'],
        'hlp ' => ['bmp'],
);

# Verbose phrase tag
$_SDF_VERBOSE_TAG = 'V';

# Enums for phrase section types
$_SDF_PHRASE_BEGIN   = "\001";
$_SDF_PHRASE_END     = "\002";
$_SDF_PHRASE_SPECIAL = "\003";

# Lookup table of syntax escapes
%_SDF_SYNTAX_ESCAPE = (
    'lt',       '<',
    'gt',       '>',
    '2{',       '{{',
    '2}',       '}}',
    '2[',       '[[',
    '2]',       ']]',
);

# Lookup table of phrase prefixes for list tag characters
%_SDF_LIST_ALIAS = (
    '*',        'LU',
    '-',        'LU',
    '.',        'L',
    '^',        'LF',
    '+',        'LN',
    '&',        'LI',
);

# Table of macros to execute inside an excluded section of conditional text
%_SDF_MACRO_COND = (
    'if',           1,
    'elsif',        1,
    'elseif',       1,
    'else',         1,
    'endif',        1,
    '_eof_',        1,
);

# Driver validation rules
@_SDF_DRIVER_RULES = &TableParse(
    'Field      Category',
    'Name       key',
    'Library    mandatory',
    'Subroutine mandatory',
    'Paged      optional',
);

# Page size validation rules
@_SDF_PAGESIZE_RULES = &TableParse(
    'Field      Category',
    'Name       key',
    'Width      mandatory',
    'Height     mandatory',
    'Comment    optional',
);

##### Variables #####

#
# >>Description::
# {{Y:sdf_driver}} is a lookup table of valid format drivers.
# This table is build by {{Y:SdfLoadDrivers}}.
#
%sdf_driver = ();
#
# >>Description::
# {{Y:sdf_report}} is a lookup table of valid reports.
# This table is build by {{Y:SdfLoadReports}}.
#
%sdf_report = ();

#
# >>Description::
# {{Y:sdf_pagesize}} is a lookup table of valid page sizes.
# This table is build by {{Y:SdfLoadPageSizes}}.
#
%sdf_pagesize = ();

# driver lookup tables
%_sdf_driver_library = ();
%_sdf_driver_subroutine = ();
#%_sdf_driver_paged = ();

# List of sections for the current paragraph
@_sdf_section_list = ();

#
# >>Description::
# {{Y:sdf_subtopic_cnt}} is the counter of subtopics left during
# topics mode processing.
#
$sdf_subtopic_cnt = 0;

#
# >>Description::
# {{Y:sdf_fmext}} is the extension of FrameMaker template files.
# Typically values are 'fm5' and 'fm4'.
#
$sdf_fmext = 'fm5';

#
# >>Description::
# {{Y:sdf_include_path}} contains the list of directories searched
# for to find files specified in {{include}} macros.
# {{Y:sdf_library_path}} contains the list of directories searched
# for to find libraries and modules.
# In both cases, the current directory and the document's directory
# are searched before these directories and
# {{Y:sdf_lib}} is searched last of all.
#
@sdf_include_path = ();
@sdf_library_path = ();
$sdf_lib = '';

# Stacks containing state of if macros:
# * start - starting line number for error messages
# * now - is the current text section to be included?
# * yet - has a section been included yet?
# * else - has the else macro been found yet?
@sdf_if_start = ();
@sdf_if_now = ();
@sdf_if_yet = ();
@sdf_if_else = ();

# State of current block, if any
$sdf_block_start = '';
$sdf_block_type = '';
@sdf_block_text = ();
%sdf_block_param = ();
$_sdf_block_cnt = 0;
$_sdf_block_char = '';

# Stacks of starts/states for table macros
@sdf_tbl_start = ();
@sdf_tbl_state = ();

# Buffer containing finalisation code (build via the 'end' filter)
@sdf_end = ();

# Ignoring text flag (ala POD)
$sdf_cutting = 0;

# Section counter
$sdf_sections = 0;

# Next $app_lineno buffer
$_sdf_next_lineno = 0;

# Buffer holding the init line from the main topic
$_sdf_init_line = '';

# Stack of strings to append to phrases
@_sdf_append_stack = ();

# Set of component files in a book
@sdf_book_files = ();

# Stack of running reports
@sdf_report_names = ();

# Counters for generating heading prefixes
@_sdf_heading_counters = ();
@_sdf_appendix_counters = ();

# Package SDF_USER contains data exported to the user world
%SDF_USER'var = ();
$SDF_USER'style = '';
$SDF_USER'text = '';
$SDF_USER'append = '';
%SDF_USER'attr = ();
$SDF_USER'level = 0;
$SDF_USER'prev_style = '';
$SDF_USER'prev_text = '';
%SDF_USER'prev_attr = ();
%SDF_USER'previous_text_for_style = ();

##### Routines #####

#
# >>Description::
# {{Y:SdfLoadDrivers}} loads a configuration table of drivers.
# The columns are:
#
# * {{Name}} - the driver name
# * {{Library}} - the library containing the subroutine
# * {{Subroutine}} - the subroutine name.
## * {{Paged}} - a non-blank value if paged-based output is produced by default.
#
# Call this routine before calling {{Y:SdfConvert}}.
#
sub SdfLoadDrivers {
    local(@table) = @_;
#   local();
    local(@flds, $rec, %values);
    local($fmt);

    # Validate the table
    &TableValidate(*table, *_SDF_DRIVER_RULES) if $'verbose;

    # Load the drivers
    @flds = &TableFields(shift(@table));
    for $rec (@table) {
        %values = &TableRecSplit(*flds, $rec);
        $fmt = $values{'Name'};
        $sdf_driver{$fmt} = 1;
        $_sdf_driver_library{$fmt} = $values{'Library'};
        $_sdf_driver_subroutine{$fmt} = $values{'Subroutine'};
        #$_sdf_driver_paged{$fmt} = $values{'Paged'};
    }
}

#
# >>Description::
# {{Y:SdfLoadPageSizes}} loads a configuration table of page sizes.
#
sub SdfLoadPageSizes {
    local(@table) = @_;
#   local();
    local(@flds, $rec, %values);
    local($size);

    # Validate the table
    &TableValidate(*table, *_SDF_PAGESIZE_RULES) if $'verbose;

    # Load the page sizes
    @flds = &TableFields(shift(@table));
    for $rec (@table) {
        %values = &TableRecSplit(*flds, $rec);
        $size = $values{'Name'};
        $sdf_pagesize{$size} = join("\000", @values{'Width', 'Height'});

        # Add rotated page layouts
        $sdf_pagesize{$size . "R"} = join("\000", @values{'Height', 'Width'});
    }
}

#
# >>Description::
# {{Y:SdfFetch}} inputs an [[SDF]] file,
# ready for {{Y:SdfConvert}} (i.e. ready conversion to another format).
# It returns 1 if the file is opened successfully.
#
sub SdfFetch {
    local($file) = @_;
    local($success, @records);

    # Open the file
    open(SDF_FETCH, $file) || return (0, ());

    # Mark the start of a new file
    @records = ("!_bof_ '$file'");

    # Input the records
    while (<SDF_FETCH>) {
        s/[ \t\n\r]+$//;
        push(@records, $_);
    }

    # Check structured macros have all been terminated correctly
    push(@records, "!_eof_");

    # Close the stream (must occur after reference to $. above)
    close(SDF_FETCH);

    # Return result
    return (1, @records);
}

#
# >>Description::
# {{Y:SdfParse}} prepares an array of SDF strings
# for {{Y:SdfConvert}} (i.e. for conversion to another format).
#
sub SdfParse {
    local(@sdf_strs) = @_;
    local(@records);

    # Return result
    return ("!_bof_", @sdf_strs, "!_eof_");
}

#
# >>Description::
# {{Y:SdfConvert}} converts a list of sdf records to a list of
# target format paragraphs. The input records to this routine
# are usually read in by {{Y:SdfFetch}}. The output records
# are typically output to a file, separated by newlines.
# {{%convert_var}} is the initial set of variables.
#
sub SdfConvert {
    local(*p_sdf, $target, *uses, %convert_var) = @_;
    local(@result);
    local($orig_argv, $orig_context, $orig_lineno);
    local(@sdf);
    local($init_level, $i);
    local($first_line);
    local($library, $fn);

    # Init variables used in error messages.
    # $app_lineno is used as the line number as we cannot set $. - the
    # method assumes that $. is 0 (forcing AppMsg to use app_lineno instead)
    $orig_argv = $ARGV;
    $orig_context = $app_context;
    $orig_lineno = $app_lineno;

    # Init the global data
    $convert_var{'DOC_START'} = time;
    &SdfInit(*convert_var);

    # Load the standard stuff.
    # Notes:
    # *  We 'use' rather than 'inherit' stdlib as the stdlib directory
    #    is explicitly placed last on the search list - inherit would
    #    put it first (or towards the front, at least).
    @sdf = ("!use 'stdlib/stdlib'");
    push(@sdf, "!_load_look_");
    push(@sdf, "!readonly 'OPT'");
    push(@sdf, "!_load_tuning_");
    push(@sdf, "!_load_config_");

    # Load the required modules
    for $module (@uses) {
        push(@sdf, "!use '$module'");
    }

    # Adjust the initial heading level, if requested
    $init_level = $convert_var{'OPT_HEAD_LEVEL'};
    if ($init_level > 1) {
        for ($i = 1; $i < $init_level; $i++) {
            push(@sdf, "!slide_down");
        }
    }
    elsif ($init_level eq '0') {
        push(@sdf, "!slide_up");
    }

    # Adjust the heading look, if requested
    if ($convert_var{'OPT_HEAD_LOOK'} ne '') {
        my $ohl_macro = "!on paragraph '[HAP]\\d';; " .
          '$style = $var{"OPT_HEAD_LOOK"} . substr($style, 1)';
        push(@sdf, $ohl_macro);
    }

    # Do the init macro, if any, for the file first
    $first_line = $p_sdf[1];
    if ($first_line =~ /^\!\s*init\s*/) {
        unshift(@sdf, $first_line);
        $p_sdf[1] = '';
    }

    # Call the line macro first to init DOC_PATH, etc.
    unshift(@sdf, "!line 0; '$ARGV'");

    # Enable report processing, if necessary
    $report = $convert_var{'OPT_REPORT'};
    if ($report) {
        push(@sdf,   "!_bor_ $report");
        push(@p_sdf, "!_eor_");
    }

    # Prepend the user document to the config stuff
    push(@sdf, @p_sdf);

    # Call the format driver
    $library = $_sdf_driver_library{$target};
    require $library;
    $fn = $_sdf_driver_subroutine{$target};
    @result = eval {&$fn(*sdf)};
    &AppMsg('failed', $@) if $@;

    # Restore program state
    $ARGV = $orig_argv;
    $app_context = $orig_context;
    $app_lineno = $orig_lineno;

    # Return result
    return @result;
}

#
# >>Description::
# {{Y:SdfInit}} initialises global data used during the conversion process.
#
sub SdfInit {
    local(*var) = @_;
#   local();

    # Initialise the user package
    package SDF_USER;
    #reset 'a-z';   # NOTE: THIS CLEARS THE MACRO/FILTER ARG/PARAM TABLES!
    &InitMacros;
    &InitPodMacros;
    &InitFilters;
    &InitSubs;

    # Initialise the user variables
    %var = %'var;
    @include_path = @'sdf_include_path;
    @library_path = @'sdf_library_path;
    @module_path = @'sdf_library_path;

    # Initialise global variables within this package
    package main;
    $sdf_block_start = '';
    $sdf_block_type = '';
    @sdf_block_text = ();
    %sdf_block_param = ();
    $_sdf_block_cnt = 0;
    $_sdf_block_char = '';
    @_sdf_section_list = ();
    @sdf_if_start = ();
    @sdf_if_now = ();
    @sdf_if_yet = ();
    @sdf_if_else = ();
    @sdf_tbl_start = ();
    @sdf_tbl_state = ();
    @sdf_end = ();
    $sdf_cutting = 0;
    $sdf_sections = 0;
    $_sdf_next_lineno = 0;
    @_sdf_append_stack = ();
    @sdf_report_names = ();
    @_sdf_heading_counters = ();
    @_sdf_appendix_counters = ();
    %SDF_USER'previous_text_for_style = ();
}

#
# >>Description::
# {{Y:SdfNextPara}} gets the next paragraph from an SDF buffer.
# Format drivers use this routine to process buffers.
# {{@sdf}} is the buffer which is updated ready for
# another call to this routine.
#
sub SdfNextPara {
    local(*sdf) = @_;
    local($text, $style, %attr);
    local($_);
    local($lines, $macro, $parameters);
    local(@eaten);
    local($exclude_text);
    local($ok);
    local($macro_char);

    # Get the starting line number
    $app_lineno = $_sdf_next_lineno;

    # Process lines until we get the next paragraph
    record:
    while (defined($_ = shift(@sdf))) {
$igc_cnt++;
#print "sdf: $_<\n";

        # Handle the beginning/end of section macros directly and asap
        # for performance. (These shouldn't appears inside a block.)
        if (/^\!_([be])os_ /) {
            package SDF_USER;   # Need this for Perl 4 and 5 to work the same
            &_bos__Macro($') if $1 eq 'b';
            &_eos__Macro($') if $1 eq 'e';
            next record;
        }

        # Update the line number
        $app_lineno++ unless $sdf_sections;

        # If we're "cutting" text as POD does, ignore lines until a
        # =-style macro or !_eof_ is found
        if ($sdf_cutting) {
            next record unless /^=/ || /^!_eof_/;
            $sdf_cutting = 0;
        }

        # For block sections, save the lines in a scratch buffer
        if ($sdf_block_type ne '') {

            # We handle the non-macro case first for performance
            push(@sdf_block_text, $_),next unless /^\!_eof_/ ||
                        /^\s*$_sdf_block_char(end)?$sdf_block_type/;

            # Fetch the macro
            ($lines, $macro, $parameters) = &_SdfFetchMacro($_, *sdf, *eaten);
            $app_lineno += $lines;

            # Detect block ends
            if ($macro eq "end$sdf_block_type" && --$_sdf_block_cnt == 0) {
                unshift(@sdf, &SDF_USER'ExecMacro($macro, $parameters, 'error'));
                if (@sdf_end) {
                    push(@sdf, @sdf_end);
                    @sdf_end = ();
                }
                next record;
            }

            # Make sure end-of-file processing is not missed
            elsif ($macro eq '_eof_') {
                unshift(@sdf, &SDF_USER'ExecMacro($macro, $parameters, 'error'));
                next record;
            }

            # Detect nested blocks
            $_sdf_block_cnt++ if $macro eq $sdf_block_type;

            # Save the text into a scratch buffer
            push(@sdf_block_text, @eaten);
            next record;
        }

        # Determine the exclude_text flag
        $exclude_text = @sdf_if_now && !$sdf_if_now[$#sdf_if_now];

        # Handle macros
        if (/^\s*([=!])/) {
            $macro_char = $1;
            ($lines, $macro, $parameters) = &_SdfFetchMacro($_, *sdf, *eaten);
            $app_lineno += $lines;

            # If we are inside an excluded section of an if macro,
            # ignore everything except conditional macros (and eof checking)
            next record if $exclude_text && !$_SDF_MACRO_COND{$macro};

            # Process the macro - if this macro starts a block, set the
            # nested count and starting character accordingly
            unshift(@sdf, &SDF_USER'ExecMacro($macro, $parameters, 'warning'));
            if (@sdf_end) {
                push(@sdf, @sdf_end);
                @sdf_end = ();
            }
            if ($sdf_block_type ne '') {
                $_sdf_block_cnt = 1;
                $_sdf_block_char = "\\" . $macro_char;
            }
            next record;
        }

        # Ignore paragraphs inside an excluded section of an if macro
        next record if $exclude_text;

        # remove leading and trailing whitespace
        s/^\s+//;
        s/\s+$//;

        # skip comments and blank lines
        next record if /^#/ || /^\s*$/;

        # If we reach here, we have the start of the next paragraph
        $app_context = 'para. on ' unless $sdf_sections;
        ($lines, $ok, $style, $text, %attr) = &_SdfFetchPara($_, *sdf);

        # Convert level 0 headings to the build_title macro
        if ($style =~ /^[HAP]0$/) {
            $SDF_USER'var{'DOC_NAME'} = $text;
            unshift(@sdf, "!build_title");
            $_sdf_next_lineno--;
            next;
        }

        # Prepended text causes a failure, triggering re-processing.
        # Likewise, we return nothing if a report is running.
        $_sdf_next_lineno = $app_lineno + $lines;
        next unless $ok;
        next if @sdf_report_names;

        return ($text, $style, %attr);
    }

print "lines: $igc_cnt\n" if $SDF_USER'var{'igc'};
    # If we reach here, the buffer is empty
    return ();
}

#
# >>_Description::
# {{Y:_SdfFetchMacro}} fetches the macro starting on the current line, if any.
# {{$_}} is the current line and
# {{@rest}} is the rest of the input buffer.
# {{$lines}} is the number of lines read from {{@rest}}.
# {{@eaten}} is the set of lines consumed.
#
sub _SdfFetchMacro {
    local($_, *rest, *eaten) = @_;
    local($lines, $macro, $parameters);
    local($line);

    # At a minimum, we consume the current line.
    @eaten = ($_);

    # Handle !-style - lines ending in \ are continued onto the next line,
    # unless there are exactly 2 backslashes at the end of the line
    if (s/^\s*\!\s*//) {
        s/\s+$//;
        return (0, split(/\s+/, $_, 2)) unless /\\$/;

        # Handle \\ case
        if (/[^\\]\\\\$/) {
            s/\\$//;
            return (0, split(/\s+/, $_, 2));
        }

        # Handle other cases (1, 3, 4 ..)
        s/\\$/ /;
        $line = $_;
        while (defined($_ = shift(@rest))) {
            push(@eaten, $_);
            $lines++ unless $sdf_sections;
            s/^\s+//;
            s/\s+$//;
            $line .= $_;
            last unless $line =~ s/\\$/ /;
        }
        return ($lines, split(/\s+/, $line, 2));
    }

    # Handle =-style - an empty line terminates the macro call
    if (s/^\s*\=\s*//) {
        s/\s+$//;
        $line = $_;
        while (defined($_ = shift(@rest))) {
            push(@eaten, $_);
            $lines++ unless $sdf_sections;
            s/^\s+//;
            s/\s+$//;
            last if $_ eq '';
            $line .= " $_";
        }
        return ($lines, split(/\s+/, $line, 2));
    }
}

#
# >>_Description::
# {{Y:_SdfFetchPara}} fetches the next paragraph.
# {{$_}} is the current line and
# {{@rest}} is the rest of the input buffer.
# {{$lines}} is the number of lines read from {{@rest}}.
#
sub _SdfFetchPara {
    local($_, *rest) = @_;
    local($lines, $ok, $style, $text, %attr);
    local($para);
    local($name);

    # Handle normal paragraphs
    $para = $_;
    if ($para !~ /^__/) {
        while (defined($_ = $rest[0])) {

            # Remove leading and trailing whitespace
            s/^\s+//;
            s/\s+$//;

            # Paragraphs are terminated by macros, comments, blank lines and new
            # paragraphs - the tests are ordered to match the most likely first.
            last if /^\!/;
            last if /^\#/;
            last if /^$/;
            last if /^[-*^+\.&]+/;
            last if /^\>/;
            last if /^\=/;
            last if /^([A-Z_0-9]\w*|)\:/;
            last if /^([A-Z_0-9]\w*|)\[[^\[]/;

            # A leading \ simply escapes special characters so strip it
            s/^\\//;

            # Append this line
            $para .= " $_";
            shift(@rest);

            # Update the line number
            $lines++ unless $sdf_sections;
        }
    }

    # Parse the paragraph
#print STDERR "fetch:$para<\n";
    ($style, $text, %attr) = &_SdfParsePara($para);

    # For directives, skip the rest
    return ($lines, 1, $style, $text, %attr) if $style =~ /^__/;

    # Activate event processing
    if ($attr{'noevents'}) {
        delete $attr{'noevents'};
    }
    else {
        package SDF_USER;
        local($style, $text, %attr, @_prepend, @_append);

        $'attr{'orig_style'} = $'style;
        $style = $'style;
        $text = $'text;
        %attr = %'attr;
        @_prepend = ();
        @_append = ();
        &ReportEvents('paragraph') if @'sdf_report_names;
        &ExecEventsStyleMask(*evcode_paragraph, *evmask_paragraph);
        &ReportEvents('paragraph', 'Post') if @'sdf_report_names;
        $'style = $style;
        $'text = $text;
        %'attr = %attr;
        $level = $1 if $style =~ /^[HAP](\d)$/;
        $prev_style = $style;
        $prev_text = $text;
        %prev_attr = %attr;
        $previous_text_for_style{$style} = $text unless $attr{'continued'};
        unshift(@'rest,
            "!_bos_ $'app_lineno;text appended to ",
            @_append,
            "!_eos_ $'app_lineno;$'app_context") if @_append;
        if (@_prepend) {
#printf STDERR "prepending \n\t%s<\n", join("<\n\t", @_prepend);
            $attr{'noevents'} = 1;
            unshift(@'rest,
                "!_bos_ $'app_lineno;text prepended to ",
                @_prepend,
                &'SdfJoin($style, $text, %attr),
                "!_eos_ $'app_lineno;$'app_context");
            return ();
        }
    }

    # I'm not yet sure why, but occasionally we reach here with noevents
    # defined. If this happens, delete it.
    delete $attr{'noevents'};

    # Remove target-specific attributes for other targets
    &SdfAttrClean(*attr) if %attr;

    # Check the style is legal
    unless (defined($SDF_USER'parastyles_name{$style})) {
        &AppMsg("warning", "unknown paragraph style '$style'");
    }

    # Check the attributes are legal
    for $name (keys %attr) {
        &_SdfAttrCheck($name, $attr{$name}, "paragraph");
    }

    # Add units to size, if necessary
    # (might be better to do this as a measure type oneday?)
    if ($attr{'size'} =~ /^[\d\.]+$/) {
        $attr{'size'} .= 'pt';
    }

    # Return result
#printf STDERR  "style:$style, text:$text.\n";
    return ($lines, 1, $style, $text, %attr);
}

#
# >>_Description::
# {{Y:_SdfParsePara}} parses an SDF paragraph into its components.
#
sub _SdfParsePara {
    local($para) = @_;
    local($style, $text, %attr);
    local($attrs);
    local($tab_size);
    local($level);
    local($special);
#print STDERR "para:$para.\n";

    # Handle paragraphs with normal styles
    if ($para =~ /^([A-Z_0-9]\w*|):/ || $para =~ /^([A-Z_0-9]\w*|)\[\s*\]/) {
        $style = $1;
        $attrs = '';
        $text = $';
    }
    elsif ($para =~ /^([A-Z_0-9]\w*|)\[([^\[][^\]]*)\]/) {
        $style = $1;
        $attrs = $2;
        $text = $';

        # If the ] was escaped, we need to find the real one
        # in a non-greedy way
        if ($attrs =~ s/\\$/]/) {
            if ($text =~ /(.*?[^\\])\]/) {
                $attrs .= $1;
                $text = $';
#print "attrs: $attrs.\n";
#print "text : $text.\n";
            }
            else {
                $attrs .= $text;
                $text = '';
                &AppMsg("warning", "] at end of attributes not found");
            }
        }
    }

    # Handle paragraphs with shorthand styles
    elsif ($para =~ /^(>)/) {
        $style = 'V';
        $attrs = '';
        $text = $';
    }
    elsif ($para =~ /^([-*^+\.&]{1,6})(\[\s*\])?/) {
        $special = $1;
        $attrs = '';
        $text = $';
    }
    elsif ($para =~ /^([-*^+\.&]{1,6})(\[([^\]][^\]]*)\])?/) {
        $special = $1;
        $level = length($1);
        $level++ if substr($1, 0, 1) eq '-' && $level < 6;
        $style = "$_SDF_LIST_ALIAS{$1}$level";
        $attrs = $3;
        $text = $';
    }

    # Handle normal paragraphs
    else {
        $style = '';
        $attrs = '';
        $text = $para;

        # A leading \ simply escapes special characters so strip it
        $text =~ s/^\\//;

    }

    # Parse the attributes
    %attr = &SdfAttrSplit($attrs) if $attrs ne '';

    # Convert the special tag to a style, if necessary
    if ($special) {
        $level = length($special);
        $special = substr($special, 0, 1);
        $level++ if $special eq '-' && $level < 6;
        $style = "$_SDF_LIST_ALIAS{$special}$level";
    }

    # If the style is not set, use the default style
    $style = 'N' if $style eq '';

    # Map aliases
    if ($style eq 'V') {
        $style = 'E';
        $attr{'verbatim'} = 1;
    }

    # Trim leading space except for examples and internal directives
    # For examples, convert tabs to spaces
    if ($SDF_USER'parastyles_category{$style} eq 'example') {
        $tab_size = $SDF_USER'var{'DEFAULT_TAB_SIZE'};
        1 while $text =~ s/\t+/' ' x (length($&) * $tab_size - length($`) % $tab_size)/e;
    }
    elsif ($style !~ /^__/) {
        $text =~ s/^\s+//;
    }

    # Return result
    return ($style, $text, %attr);
}

#
# >>Description::
# {{Y:SdfParseCell}} parses an SDF cell into its components.
#
sub SdfParseCell {
    local($cell) = @_;
    local($text, %attr);
    local($attrs);

    # Simple for now
    if ($cell =~ /^\s*\[\s*\]/) {
        $attrs = '';
        $text = $';
    }
    if ($cell =~ /^\s*\[\s*([a-z][^\]]*)\s*\]/) {
        $attrs = $1;
        $text = $';
    }
    else {
        $attrs = '';
        $text = $cell;
    }

    # Parse the attributes
    %attr = &SdfAttrSplit($attrs) if $attrs ne '';

    # Return result
    return ($text, %attr);
}

#
# >>_Description::
# {{Y:_SdfParaExpand}} expands embedded expressions
# within a paragraph.
#
sub _SdfParaExpand {
    local($text) = @_;
    local($expanded);
    local($pre, $mid, $begin, $end);

    # Handle embedded expressions
    $expanded = '';
    section:
    while ($text ne '') {
        # Get the next set of delimiters
        $begin = index($text, '[[');
        last section unless $begin >= 0;
        $end = index($text, ']]', $begin + 2);
        last section unless $end >= 0;

        # Get the sub-strings
        $pre = substr($text, 0, $begin);
        $mid = substr($text, $begin + 2, $end - $begin - 2);
        $mid = &_SdfEvaluate($mid, "warning");
        $text = substr($text, $end + 2);

        # handle nested expansion
        if (index($mid, '[[') >= 0) {
            $mid = &_SdfParaExpand($mid);
        }

        # Build the result
        $expanded .= $pre . $mid;
    }
    if ($text ne '') {
        # Build the result
        $expanded .= $text;
    }

    # return result
    return $expanded;
}

#
# >>_Description::
# {{Y:_SdfVerbosePhrases}} expands E<2{> style phrases within a paragraph.
#
sub _SdfVerbosePhrases {
    local($text) = @_;
    local($expanded);
    local($nested);
    my($begin_index, $end_index);

    # Convert the other escapes
    $nested = 0;
    while ($text ne '') {

        # A nested }} without a proceeding {{ is a phrase end
        $begin_index = ($text =~ /\{\{/) ? length($`) : length($text);
        $end_index =   ($text =~ /\}\}/) ? length($`) : length($text);
        if ($nested && ($end_index < $begin_index)) {
            $nested--;
            $text = $';
            $expanded .= &_SdfVerboseEscape($`) . '>';
        }

        # A phrase which may have something nested
        elsif ($text =~ /\{\{/) {
            $expanded .= "$`$_SDF_VERBOSE_TAG<";
            $text = $';
            $nested++;
        }

        # No sequences left
        else {
            $expanded .= $text;
            $text = '';
        }
    }

    # return result
    return $expanded;
}

#
# >>_Description::
# {{Y:_SdfVerboseEscape}} escapes chatacters within a E<2{> style phrase.
#
sub _SdfVerboseEscape {
    local($text) = @_;
    local($result);

    # If a [A-Z]< style phrase is found, do nothing
    return $text if $text =~ /[A-Z]\</;

    # Otherwise, escape > characters
    $result = $text;
    $result =~ s/\>/E<gt>/g;
    return $result;
}

#
# >>_Description::
# {{Y:_SdfTextToSections}} converts paragraph text to a list of sections.
#
sub _SdfTextToSections {
    local($text) = @_;
    local(@section);
    local(@nested);
    local($append);
    # The ones above are explicitly local so that *xxx works for
    # calls to SdfAddPhrase
    my($begin_index, $end_index);

    # Do expression and long phrase substitution on the text
#print "text 1:$text<\n";
    $text = &_SdfParaExpand($text);
#print "text 2:$text<\n";
    $text = &_SdfVerbosePhrases($text);
#print "text 3:$text<\n";

    # Parse the string into bits
    $append = 0;
    while ($text ne '') {

        # A > without a proceeding [A-Z]< is a sequence end marker
        $begin_index = ($text =~ /[A-Z]\</) ? length($`) : length($text);
        $end_index =   ($text =~ /\>/)      ? length($`) : length($text);
        if (@nested && ($end_index < $begin_index)) {
            $text = $';
            &_SdfAddPhrase($`, *text, *section, *nested, *append);
        }

        # A sequence which starts immediately
        elsif ($text =~ /^([A-Z])\</) {
            push(@section, $_SDF_PHRASE_BEGIN);
            push(@nested, $#section);
            push(@section, $1);
            $text = $';
            $append = 1;
        }

        # Some text before a sequence
        elsif ($text =~ /([A-Z])\</) {
            $append = 0 unless @section;
            if ($append) {
                $section[$#section] .= $`;
            }
            else {
                push(@section, $`);
            }
            $text = "$1<$'";
        }

        # No sequences left
        else {
            $append = 0 unless @section;
            if ($append) {
                $section[$#section] .= $text;
            }
            else {
                push(@section, $text);
            }
            $text = '';
        }
    }

    # Warn about unterminated phrases and terminate them
    my $tag;
    while (@nested) {
        $tag = substr($section[$nested[$#nested] + 1], 0, 1);
        if ($tag eq $_SDF_VERBOSE_TAG) {
            &'AppMsg("warning", "{{ phrase not terminated");
        }
        else {
            &'AppMsg("warning", "'$tag' phrase not terminated");
        }
        &_SdfAddPhrase('', *text, *section, *nested, *append);
    }

for $igc (@section) {
if ($igc =~ /^(\001|\002|\003)/) {
#print unpack('C*', $1) . ":\n";
}
else {
#print "$igc<\n";
}
}

    # Return result
    return @section;
}
sub _SdfAddPhrase {
    local($phrase, *text, *section, *nested, *append) = @_;
#   local();
    my($tag);
    my($sect_style, $sect_text, $sect_append, %sect_attr);
    my($start);
    my($escape);

    $start = pop(@nested);
    $tag = substr($section[$start + 1], 0, 1);
#print "tag:$tag,phrase:$phrase,start:$start.\n";
    if ($tag eq 'Z') {
        pop(@section);
        pop(@section);
    }
    elsif ($tag eq 'E' && ($escape = $_SDF_SYNTAX_ESCAPE{$phrase})) {
#print "escape:$escape.\n";
        pop(@section);
        pop(@section);
        if (@section && $section[$#section] ne $_SDF_PHRASE_END) {
            $section[$#section] .= $escape;
        }
        else {
            push(@section, $escape);
        }
    }
    else {
        if ($append) {
            $section[$#section] .= $phrase;
        }
        else {
            push(@section, $phrase);
        }
        $append = 0;

        ($sect_style, $sect_text, $sect_append, %sect_attr) =
          &_SdfPhraseProcess($tag, substr($section[$start + 1], 1));
#print "style:$sect_style,text:$sect_text,append:$sect_append<\n";
        if ($sect_style =~ /^__/) {
            $sect_style = substr($sect_style, 2);
            $section[$start] = $_SDF_PHRASE_SPECIAL;
        }
        else {
            push(@section, $_SDF_PHRASE_END);
        }
        $section[$start + 1] = [$sect_text, $sect_style, %sect_attr];
        $text = $sect_append . $text if $sect_append ne '';
    }
}

#
# >>Description::
# {{Y:SdfNextSection}} gets the next section of a paragraph.
# Format drivers use this routine to process paragraphs.
# {{$para}} is the paragraph text which is updated ready for
# another call to this routine. {{$state}} is a state variable
# which this routines uses to help it keep state.
# {{sect_type}} is one of:
#
# * {{string}} - a string normal paragraph text
# * {{phrase}} - a phrase
# * {{phrase_end}} - end of a phrase
# * {{special}} - a special phrase (e.g. CHAR, IMPORT, etc.)
# * an empty string - end of paragraph
#
# For a string, {{text}} is the string, {{style}} and {{attr}} are empty.
# At the end of a phrase, {{text}}, {{style}} and {{attr}} are empty.
#
sub SdfNextSection {
    local(*para, *state) = @_;
    local($sect_type, $text, $style, %attr);
    local($section);

    # Init things, if necessary
    if ($state == 0) {
        @_sdf_section_list = &_SdfTextToSections($para);
    }
#print "$para<\n", "state:$state,", $#_sdf_section_list, "\n";

    # Check for end of paragraph
    return () if $state > $#_sdf_section_list;

    # Get the next section
    $section = $_sdf_section_list[$state++];

    # Handle end of phrase
    if ($section eq $_SDF_PHRASE_END) {
        return ("phrase_end");
    }

    # Handle phrases
    elsif ($section eq $_SDF_PHRASE_BEGIN) {
        return ("phrase", @{$_sdf_section_list[$state++]});
    }

    # Handle special phrases
    elsif ($section eq $_SDF_PHRASE_SPECIAL) {
        return ("special", @{$_sdf_section_list[$state++]});
    }

    # Must be a normal paragraph
    else {
        return ("string", $section);
    }
}

#
# >>_Description::
# {{Y:_SdfPhraseProcess}} processes a phrase.
# It returns the style, text and attributes.
#
sub _SdfPhraseProcess {
    local($tag, $sdf) = @_;
    local($style, $text, $append, %attr);
    local($attrs);
    local($name);
    local($fn);

#print "phrase:$tag,$sdf<\n";
    # Get the components
    if ($tag ne $_SDF_VERBOSE_TAG) {
        $style = $tag eq 'E' ? 'CHAR' : $tag;
        $attrs = '';
        $text = $sdf;
    }
    elsif ($sdf =~ /^([A-Z_0-9]\w*|):/ || $sdf =~ /^([A-Z_0-9]\w*|)\[\s*\]/) {
        $style = $1;
        $attrs = '';
        $text = $';
    }
    elsif ($sdf =~ /^([A-Z_0-9]\w*|)(\[([^\[][^\]]*)\])/) {
        $style = $1;
        $attrs = $3;
        $text = $';

        # If the ] was escaped, we need to find the real one
        # in a non-greedy way
        if ($attrs =~ s/\\$/]/) {
            if ($text =~ /(.*?[^\\])\]/) {
                $attrs .= $1;
                $text = $';
#print "attrs: $attrs.\n";
#print "text : $text.\n";
            }
            else {
                $attrs .= $text;
                $text = '';
                &AppMsg("warning", "] at end of attributes not found");
            }
        }
    }
    else {
        $style = '';
        $attrs = '';
        $text = $sdf;
    }

    # If not set, use the default style
    $style = 1 if $style eq '';

    # Trim leading space except for examples
    if ($SDF_USER'phrasestyles_category{$style} ne 'example') {
        $text =~ s/^\s+//;
    }

    # Parse the attributes
    %attr = &SdfAttrSplit($attrs);

    # Handle special styles
    if ($SDF_USER'phrasestyles_category{$style} eq 'special') {
        $fn = "SDF_USER'${style}_Special";
        if (defined &$fn) {
            &$fn(*style, *text, *attr);
        }
        else {
            &AppMsg("warning", "unable to find handler for special style '$style'");
        }
        return ($style, $text, '', %attr);
    }

    # Activate event processing
    package SDF_USER;
    $style = $'style;
    $text = $'text;
    $append = '';
    %attr = %'attr;
    &ReportEvents('phrase') if @'sdf_report_names;
    &ExecEventsStyleMask(*evcode_phrase, *evmask_phrase);
    &ReportEvents('phrase', 'Post') if @'sdf_report_names;
    $'style = $style;
    $'text = $text;
    $'append = $append;
    %'attr = %attr;
    undef $style;
    undef $text;
    undef %attr;
    package main;

    # Check for hypertext
    #$style = 'JUMP' if $attr{'jump'} ne '';

    # Default index text, if necessary
    if ($attr{'index'} eq '1' ||
        $attr{'index_type'} ne '' && $attr{'index'} eq '') {
        $attr{'index'} = $text;
    }

    # Add units to size, if necessary
    # (might be better to do this as a measure type oneday?)
    if ($attr{'size'} =~ /^[\d\.]+$/) {
        $attr{'size'} .= 'pt';
    }

    # Check the style is legal
    if ($style !~ /^__/) {
        unless (defined($SDF_USER'phrasestyles_name{$style})) {
            &AppMsg("warning", "unknown phrase style '$style'");
        }
    }

    # Remove target-specific attributes for other targets
    &SdfAttrClean(*attr);

    # check the attributes are legal
    for $name (keys %attr) {
        &_SdfAttrCheck($name, $attr{$name}, "phrase");
    }

    # Return result
    return ($style, $text, $append, %attr);
}

#
# >>Description::
# {{Y:SdfPoints}} converts a measurement to points.
# This is required for calculations involving measurements.
#
sub SdfPoints {
    local($measure) = @_;
#   local($pts);

    return 0 unless $measure =~ /^([\d\.]+)/;
    if ($' eq 'pt' || $' eq '') {
        # We put this first for performance reasons
        return $1;
    }
    elsif ($' eq 'in' || $' eq '"') {
        return $1 * 72;
    }
    elsif ($' eq 'mm') {
        return $1 * 2.835;
    }
    elsif ($' eq 'cm') {
        return $1 * 28.35;
    }
    else {
        return 0;
    }
}

#
# >>Description::
# {{Y:SdfVarPoints}} converts an variable to points.
#
sub SdfVarPoints {
    local($name) = @_;
#   local($pts);

    return &SdfPoints($SDF_USER'var{$name});
}

#
# >>Description::
# {{Y:SdfPageInfo}} returns information about a page.
#
sub SdfPageInfo {
    local($page, $attr, $category) = @_;
    local($info);
    local($part, $newpage);

    if ($category eq 'macro') {
        if (defined $SDF_USER'macro{"PAGE_${page}_$attr"}) {
            $info = $SDF_USER'macro{"PAGE_${page}_$attr"};
        }
        elsif ($page =~ /_/) {
            ($part, $newpage) = ($`, $');
            $newpage = 'RIGHT' if $newpage eq 'FIRST' && $part ne 'FRONT';
#printf STDERR "$page -> $newpage ($attr)\n";
            $info = $SDF_USER'macro{"PAGE_${newpage}_$attr"};
        }
    }
    else {
        if (defined $SDF_USER'var{"PAGE_${page}_$attr"}) {
            $info = $SDF_USER'var{"PAGE_${page}_$attr"};
        }
        elsif ($page =~ /_/) {
            ($part, $newpage) = ($`, $');
            $newpage = 'RIGHT' if $newpage eq 'FIRST' && $part ne 'FRONT';
#printf STDERR "$page -> $newpage ($attr)\n";
            $info = $SDF_USER'var{"PAGE_${newpage}_$attr"};
        }
        if ($category eq 'pt') {
            $info = &SdfPoints($info);
        }
    }

    # Return result
    return $info;
}

#
# >>_Description::
# {{Y:_SdfEvaluate}} evaluates and returns an SDF expression.
# If only a word is found which looks like an enumerated value (i.e.
# first character is uppercase & remaining characters are lowercase)
# and {{enum}} is true, then that word is returned as a string.
# If only a name is found, the result is the value of that variable.
# If only a '!' character followed by a name is found,
# the result is the negation of that variable.
# If the first character is + or =, then the rest is assumed to
# be an argument to the {{Calc}} subroutine.
# Otherwise, the expression is evaluated as Perl. If Perl cannot
# evaulate the expression, an error is output. If the expression
# looks like a name and it is not defined and {{msg_type}} is
# specified, then a message of that type is output explaining
# that the variable is unknown. In either case, we return an empty
# string if the variable is not found or the evaluation fails.
#
sub _SdfEvaluate {
    local($expr, $msg_type, $enum) = @_;
    local($result);
    local($format);
    local($action, $SDF_USER'_);

    # Get the format, if any
    $format = $1 if $expr =~ s/^(\w+)://;

    # Handle simple numbers and strings directly (i.e. skip the eval)
    if ($expr =~ /^"([^"\\\$]*)"$/ || $expr =~ /^'([^'\\]*)'$/) {
        $result = $1;
    }
    elsif ($expr =~ /^\d+$/) {
        $result = $expr;
    }

    # Enumerated values
    elsif ($enum && $expr =~ /^[A-Z][a-z]+$/) {
        $result = $expr;
    }

    # Variables
    elsif ($expr =~ /^\w+$/) {
        if (!defined($SDF_USER'var{$expr})) {
            if ($msg_type) {
                &AppMsg($msg_type, "variable '$expr' not defined");
            }
            $result = '';
        }
        else {
            $result = $SDF_USER'var{$expr};
        }
    }
    elsif ($expr =~ /^\!\s*(\w+)$/) {
        $result = $SDF_USER'var{$1} ? 0 : 1;
    }
    elsif ($expr =~ /^$/) {
        $result = '';
    }

    # Handle implicit calls to Calc
    elsif ($expr =~ /^[=+]\s*(.+)$/) {
        $result = &SDF_USER'Calc($1);
    }

    else {
        # evaluate the expression in "user-land"
        package SDF_USER;
        $main'result = eval $main'expr;
        package main;
        if ($@) {
            &AppMsg("warning", "evaluation of '$expr' failed: $@");
            $result = '';
        }
    }

    # Apply the format, if any
    if ($format ne '') {
        $action = $SDF_USER'var{"FORMAT_$format"};
        if ($action eq '') {
            &AppMsg("warning", "unknown format '$format'");
        }
        else {
            package SDF_USER;
            $_ = $main'result;
            $main'result = eval $main'action;
            package main;
            if ($@) {
                &AppMsg("warning", "format '$format' failed: $@");
            }
        }
    }

    # Return result
    return $result;
}

#
# >>Description::
# {{Y:SdfJoin}} formats a style, text and attributes into a paragraph.
#
sub SdfJoin {
    local($style, $text, %attr) = @_;
    local($sdf);

    # Return result
    return join('', $style, '[', &SdfAttrJoin(*attr), ']', $text);
}

#
# >>Description::
# {{Y:SdfAttrSplit}} parses a string of attributes into a set of
# name-value pairs.
#
sub SdfAttrSplit {
    local($attrs) = @_;
    local(%attrs);
    local(@attrs, $append);
    local($attr, $name, $value);

    # build the list of attributes, remembering that ';;' means ';', but
    # ignoring a leading ';'.
    $attrs =~ s/^\s*;\s*//;
    @attrs = ();
    $append = 0;
    for $attr (split(/;/, $attrs)) {
        if ($attr eq '') {
            $attrs[$#attrs] .= ';';
            $append = 1;
        }
        elsif ($append) {
            $attrs[$#attrs] .= $attr;
            $append = 0;
        }
        else {
            $attr =~ s/^\s+//;
            $attr =~ s/\s+$//;
            push(@attrs, $attr) if $attr ne '';
        }
    }

    # parse the attributes  
    for $attr (@attrs) {
        if ($attr =~ /^([^=]+)\=/) {
            $name = $1;
            $value = &_SdfEvaluate($', '', 1);
        }
        else {
            $name = $attr;
            $value = 1;
        }
        $attrs{$name} = $value;
    }

    # return result
    return %attrs;
}

#
# >>Description::
# {{Y:SdfAttrJoin}} formats a set of name-value pairs (%attr) into a string.
# {{sep}} is the separator to use between attributes. The default
# separator is semi-colon.
#
sub SdfAttrJoin {
    local(*attr, $sep) = @_;
    local($attrtext);
    local($key, $value, @attrtext);

    # default the separator
    $sep = ";" if $sep eq '';

    # convert the attributes to text
    @attrtext = ();
    for $key (keys %attr) {
        $value = $attr{$key};
        #$value =~ s/\\/\\\\/g;
        #$value =~ s/'/\\'/g;
        #$value =~ s/([\]])/\\]/g;
        $value =~ s/(['\]\\])/\\$1/g;
        if ($sep eq ";") {
            $value =~ s/\;+/$&;/g;
        }
        if ($value !~ /^\d+$/) {
            $value = "'" . $value . "'";
        }
        push(@attrtext, "$key=$value");
    }
    $attrtext = join($sep, @attrtext);

    # Return result
#print "attrs: $attrtext.\n";
    return $attrtext;
}

#
# >>Description::
# {{Y:SdfAttrJoinSorted}} formats a set of name-value pairs (%attr) into
# a string where the attributes are sorted by name.
# {{sep}} is the separator to use between attributes. The default
# separator is semi-colon.
#
sub SdfAttrJoinSorted {
    local(*attr, $sep) = @_;
    local($attrtext);
    local($key, $value, @attrtext);

    # default the separator
    $sep = ";" if $sep eq '';

    # convert the attributes to text
    @attrtext = ();
    for $key (sort keys %attr) {
        $value = $attr{$key};
        #$value =~ s/\\/\\\\/g;
        #$value =~ s/'/\\'/g;
        #$value =~ s/([\]])/\\]/g;
        $value =~ s/(['\]\\])/\\$1/g;
        if ($sep eq ";") {
            $value =~ s/\;+/$&;/g;
        }
        if ($value !~ /^\d+$/) {
            $value = "'" . $value . "'";
        }
        push(@attrtext, "$key=$value");
    }
    $attrtext = join($sep, @attrtext);

    # Return result
    return $attrtext;
}

#
# >>Description::
# {{Y:SdfAttrClean}} removes target-specific attributes (for other targets)
# from a set of attributes. However, if the driver is 'raw', all attributes
# are kept.
#
sub SdfAttrClean {
    local(*attr) = @_;
#   local();
    local($driver, $target);
    local($name);

    # Keep all attributes for raw format
    $driver = $SDF_USER'var{'OPT_DRIVER'};
    return if $driver eq 'raw';

    # Delete attributes in 'families' other than the current driver or target
    $target = $SDF_USER'var{'OPT_TARGET'};
    for $name (keys %attr) {
        delete $attr{$name} if $name =~ /^(\w+)\./ && $1 ne $driver &&
          $1 ne $target;
    }
}

#
# >>Description::
# {{Y:SdfAttrMap}} maps a set of attributes using the configuration tables
# {{%map_to}}, {{%map_map}} and {{%map_attrs}}.
# {{$defaults}} is a string of default attributes.
# This routine is used by format drivers to merge user-supplied
# attributes with those in 'attribute' and 'style' configuration tables.
#
sub SdfAttrMap {
    local(*attr, $target, *map_to, *map_map, *map_attrs, $defaults) = @_;
#   local();
    local($name, $value, $to, $map, %new, $new);

    # Map the user-supplied attributes
    for $name (keys %attr) {
        $value = $attr{$name};

        # Get the configuration details
        $to = $map_to{$name};
        $map = $map_map{$name};
        %new = &SdfAttrSplit($map_attrs{$name});

        # If 'To' is set, change the name
        #$name = "$target.$to" if $to ne '';
        if ($to ne '') {
            delete $attr{$name};    # delete the existing name
            $name = "$target.$to";
        }

        # If 'Map' is set, change the value
        &_SdfAttrValueMap(*value, $map) if $map;
 
        # Update the changes, if any
        if ($to || $map) {
            $attr{$name} = $value;
#print "new $name=$value<\n";
        }

        # Add implicit attributes, if any
        for $new (keys %new) {
            $attr{"$target.$new"} = $new{$new};
        }
    }

    # Merge in the defaults
    %new = &SdfAttrSplit($defaults);
    for $new (keys %new) {
        $name = "$target.$new";
        $attr{$name} = $new{$new} unless defined $attr{$name};
    }
}

#
# >>_Description::
# {{Y:_SdfAttrValueMap}} maps a value using either a lookup table or
# a subroutine.
#
sub _SdfAttrValueMap {
    local(*value, $map) = @_;
#   local();
    local($name, $action);
    local($newvalue);

    # Build the action
    $name = substr($map, 1);
    $action = ($map =~ /^\%/) ? "\$$name\{\$'value\}" : "&$name(\$'value)";

    # Get the new value
    package SDF_USER;
    $'newvalue = eval $'action;
    package main;
    &AppMsg("warning", "attribute mapping via '$map' failed: $@ (action: $action)") if $@;
    $value = $newvalue if defined $newvalue;
}

#
# >>_Description::
# {{Y:_SdfAttrCheck}} checks an attribute.
# {{kind}} should be either "phrase" or "paragraph".
#
sub _SdfAttrCheck {
    local($name, $value, $kind) = @_;
#   local();
    local($type, $rule);

    # check the attribute is known & get the type and rule, if any
    if ($kind eq 'paragraph') {
        unless ($SDF_USER'paraattrs_name{$name}) {
            &AppMsg("warning", "unknown paragraph attribute '$name'");
        }
        $type = $SDF_USER'paraattrs_type{$name};
        $rule = $SDF_USER'paraattrs_rule{$name};
    }
    else {
        unless ($SDF_USER'phraseattrs_name{$name}) {
            &AppMsg("warning", "unknown phrase attribute '$name'");
        }
        $type = $SDF_USER'phraseattrs_type{$name};
        $rule = $SDF_USER'phraseattrs_rule{$name};
    }


    # validate the rule, if any
    unless (&MiscCheckRule($value, $rule, $type)) {
        &AppMsg("warning", "bad value '$value' for $kind attribute '$name'");
    }
}

#
# >>Description::
# {{Y:SdfSizeGraphic}} returns the {{width}} and {{height}} of a graphic
# stored in {{file}}. Zero is returned for both values if the size could not
# be extracted. File types currently supported are EPSI, PICT, GIF and PCX.
#
sub SdfSizeGraphic {
    local($file) = @_;
    local($width, $height);
    local($ext);
    local($line);
    local($junk, $tlbr, $top, $left, $bottom, $right, $xy);
    local($xmin1, $xmin2, $ymin1, $ymin2, $xmax1, $xmax2, $ymax1, $ymax2);
    local($wh, $w1, $w2, $h1, $h2);
    local($upi1, $upi2, $scale);

    # Get the file extension
    $ext = (&'NameSplit($file))[2];

    # Open the file
    open(SDF_GRAPHIC, $file) || return (0,0);

    # EPSI files: look for BoundingBox statement
    if ($ext eq 'eps' || $ext eq 'epsi' || $ext eq 'ai') {
        while (($line = <SDF_GRAPHIC>) ne '') {
            if ($line =~ /^%%BoundingBox:\s+([\d\.]+)\s+([\d\.]+)\s+([\d\.]+)\s+([\d\.]+)/) {
                $width = sprintf("%dpt", $3 - $1 + 1);
                $height = sprintf("%dpt", $4 - $2 + 1);
                last;
            }
        }
    }

    # PICT files: bytes 514+8 are Top,Left and Bottom,Right
    elsif ($ext eq 'pct' || $ext eq 'pict') {
        if (read(SDF_GRAPHIC, $junk, 514) && read(SDF_GRAPHIC, $tlbr, 8)) {
            ($top, $left, $bottom, $right) = unpack("S4", $tlbr);
            $width = sprintf("%dpt", $right - $left + 1);
            $height = sprintf("%dpt", $bottom - $top + 1);
        }
    }

    # GIF files: bytes 7-10 are width and height with low order byte 1st
    elsif ($ext eq 'gif') {
        if (read(SDF_GRAPHIC, $junk, 6) && read(SDF_GRAPHIC, $wh, 4)) {
            ($w1, $w2, $h1, $h2) = unpack("C4", $wh);
            $width  = sprintf("%dpt", $w2 * 256 + $w1);
            $height = sprintf("%dpt", $h2 * 256 + $h1);
        }
    }

    # PCX files: bytes 5-12 are Xmin,Ymin,Xmax,Ymax with low order byte 1st
    elsif ($ext eq 'pcx') {
        if (read(SDF_GRAPHIC, $junk, 4) && read(SDF_GRAPHIC, $xy, 8)) {
            ($xmin1, $xmin2, $ymin1, $ymin2,
             $xmax1, $xmax2, $ymax1, $ymax2) = unpack("C8", $xy);
            $top    = $ymin2 * 256 + $ymin1;
            $left   = $xmin2 * 256 + $xmin1;
            $right  = $xmax2 * 256 + $xmax1;
            $bottom = $ymax2 * 256 + $ymax1;
            $width = sprintf("%dpt", $right - $left + 1);
            $height = sprintf("%dpt", $bottom - $top + 1);
        }
    }

    # WMF files: bytes 7-16 are Xmin,Ymin,Xmax,Ymax,units_per_inch
    # with low order byte 1st
    elsif ($ext eq 'wmf') {
        if (read(SDF_GRAPHIC, $junk, 6) && read(SDF_GRAPHIC, $xy, 10)) {
            ($xmin1, $xmin2, $ymin1, $ymin2,
             $xmax1, $xmax2, $ymax1, $ymax2,
             $upi1, $upi2) = unpack("C10", $xy);
#print STDERR "$xmin1, $xmin2, $ymin1, $ymin2.\n";
#print STDERR "$xmax1, $xmax2, $ymax1, $ymax2.\n";
#print STDERR "$upi1, $upi2.\n";
            $top    = $ymin2 * 256 + $ymin1;
            $left   = $xmin2 * 256 + $xmin1;
            $right  = $xmax2 * 256 + $xmax1;
            $bottom = $ymax2 * 256 + $ymax1;
            $scale  = ($upi2  * 256 + $upi1) / 72;
#print STDERR "$top, $left, $right, $bottom, $scale.\n";
            if ($top > 32768) {
                # Assume central origin (as output by Powerpoint)
                $width = sprintf("%dpt", $right * 2 / $scale);
                $height = sprintf("%dpt", $bottom * 2 / $scale);
            }
            else {
                $width = sprintf("%dpt", ($right - $left + 1) / $scale);
                $height = sprintf("%dpt", ($bottom - $top + 1) / $scale);
            }
        }
    }

    # BMP files: bytes 19-23 and 24-27 are width and height
    elsif ($ext eq 'bmp') {
        if (read(SDF_GRAPHIC, $junk, 18) && read(SDF_GRAPHIC, $wh, 8)) {
            ($w1, $w2, $w3, $w4, $h1, $h2, $h3, $h4) = unpack("C8", $wh);
            $width  = sprintf("%dpt", $w3 * 256 + $w1);
            $height = sprintf("%dpt", $h3 * 256 + $h1);
        }
    }

    else {
        $width = 0;
        $height = 0;
    }

    # Close the file
    close(SDF_GRAPHIC);

    # Return result
    return ($width, $height);
}

#
# >>Description::
# {{Y:SdfColPositions}} returns a list of column positions
# given a total number of columns, a format attribute and
# a right margin.
#
sub SdfColPositions {
    local($columns, $format, $margin) = @_;
    local(@result);
    local($assigned);
    local($known);
    local($col);
    local($guess);
    local($ratio);

    # Find out how many columns are known
    $assigned = 0;
    $known = 0;
    for $col (split(/,/, $format)) {
        if ($col =~ s/^([\d\.]+)\%$/\1/) {
            $assigned += $col;
            $known++;
        }
        else {
            $col = 0;
        }
        push(@result, $col);
    }

    # Divide the rest of the space, if necessary
    if ($known < $columns) {
        $guess = (100 - $assigned)/($columns - $known);
        for ($col = 0; $col < $columns; $col++) {
            $result[$col] = $guess if $result[$col] == 0;
        }
    }

    # Convert the percentages to positions
    for ($col = 1; $col < $columns; $col++) {
        $result[$col] += $result[$col - 1];
    }
    $#result = $columns - 1;
    $ratio = $margin/100;
    for $col (@result) {
        $col = int ($col * $ratio + 0.5);
    }

    # Return result
    return @result;
}

#
# >>Description::
# {{Y:SdfHeadingPrefix}} returns the prefix for the next heading.
# {{type}} is H, A or P and {{level}} is the heading level.
#
sub SdfHeadingPrefix {
    local($type, $level) = @_;
    local($prefix);

    # For plain headings, we do nothing
    return '' if $type eq 'P';

    # The counter arrays start from 0, so adjust the level accordingly
    $level--;

    # For chapter headings, we number things as 1, 1.1, 1.2, etc.
    if ($type eq 'H') {
        $_sdf_heading_counters[$level]++;
        $#_sdf_heading_counters = $level;
        return join('.', @_sdf_heading_counters) . ". ";
    }

    # For appendix headings, we number things as A, A.1, A.2, etc.
    elsif ($type eq 'A') {
        if ($level == 0 && scalar(@_sdf_appendix_counters) == 0) {
            $_sdf_appendix_counters[$level] = 'A';
        }
        else {
            $_sdf_appendix_counters[$level]++;
        }
        $#_sdf_appendix_counters = $level;
        return join('.', @_sdf_appendix_counters) . ". ";
    }
}


########## Post Processing User Routines ##########

# switch to the user package
package SDF_USER;

# execute a system command
sub SdfSystem {
    local($cmd) = @_;
    local($exit_code);

    &'AppMsg("object", "executing '$cmd'\n") if $'verbose >= 1;
    $exit_code = system($cmd);
    if ($exit_code) {
        $exit_code = $exit_code / 256;
        &'AppMsg("warning", "'$action' exit code was $exit_code from '$cmd'");
    }
    return $exit_code;
}

# execute a system command quietly (i.e. only show output if an error
# occurred on verbose mode was enabled)
sub SdfQuietSystem {
    local($cmd) = @_;
    local($exit_code);

    # Save the output in a temporary file
    my $tmp_file = "/tmp/sdf$$";
    $cmd .= " > $tmp_file";
    $cmd .= " 2>&1" if $'NAME_OS eq 'unix';

    # Execute the command
    $exit_code = &SdfSystem($cmd);

    # If verbose mode is on, or something went wrong, show the output
    if ($verbose || $exit_code) {
        unless (open(TMPFILE, $tmp_file)) {
            &'AppMsg("app_warning", "unable to open tmp file '$tmp_file'");
        }
        else {
            print <TMPFILE>;
            close(TMPFILE);
        }
    }
    unlink($tmp_file);
    return $exit_code;
}

# execute sdfbatch
sub SdfBatch {
    local($flags) = @_;
#   local();
    local($file, $cmd);
    local($tmp_file);

    # Check the file exists
    $file = "$long.$out_ext";
    unless (-f $file) {
        &'AppMsg("error", "cannot execute sdfbatch on nonexistent file '$file'");
        return;
    }

    # Build the default command
    ## xxx installscript resolution may be better done during build time
    #$cmd = "$Config::Config{installscript}/sdfbatch $flags $short.$out_ext";
    # IGC 23/Feb/98: assume sdfbatch is on the path rather than in the
    # same place Perl is installed.
    &SdfQuietSystem("sdfbatch $flags $long.$out_ext");
}

# execute htmldoc
sub SdfHtmldoc {
    local($infile, $outfile) = @_;
#   local();

    # Check the input file exists
    unless (-f $infile) {
        &'AppMsg("error", "cannot execute htmldoc on nonexistent file '$infile'");
        return;
    }

    # Build up the flags using the document variables
    my $toc_level = $var{'DOC_TOC'};
    my $flags = $toc_level ? "--toclevels $toc_level" : "--no-toc";
    my $title = $var{'DOC_TITLE'};
    $flags .= " --no-title" if $title eq '';
    my $two_sides = $var{'DOC_TWO_SIDES'};
    $flags .= " --duplex" if $two_sides;
    my $page_size = $var{'DOC_PAGE_WIDTH'} . 'x' . $var{'DOC_PAGE_HEIGHT'};
    $flags .= " --size $page_size";
    $flags .= " --left $var{'OPT_MARGIN_INNER'}";
    $flags .= " --right $var{'OPT_MARGIN_OUTER'}";
    $flags .= " --top $var{'OPT_MARGIN_TOP'}";
    $flags .= " --bottom $var{'OPT_MARGIN_BOTTOM'}";
    my $hf = &SdfHtmldocHFOpts();
    $flags .= " $hf" if $hf;
    my $tuning = $var{'HTMLDOC_OPTS'};
    $flags .= " $tuning" if $tuning;

    # Execute the command
    &SdfQuietSystem("htmldoc $flags -f $outfile $infile");
}

# Build the header/footer options for HTMLDOC
sub SdfHtmldocHFOpts {

    return "";
}

# delete a file
sub SdfDelete {
    local($file) = @_;
#   local();

    if (-f $file) {
        &'AppMsg("object", "deleting '$file'") if $'verbose >= 1;
        unless (unlink($file)) {
            &'AppMsg("object", "delete of '$file' failed: $!");
        }
    }
}

# delete a set of files after a book build
sub SdfBookClean {
    local($ext) = @_;
#   local();
    local(@files);
    local($_);
    local(@cannot);

    # Leave things alone if verbose mode is on or there is nothing to do
    return if $'verbose;
    return unless @'sdf_book_files;

    # If an extension is given, use that set of
    # files, rather than the known ones.
    @files = @'sdf_book_files;
    if ($ext ne '') {
        for $_ (@files) {
            $_ = &'NameSubExt($_, $ext);
        }
    }

    # Delete the files
    @cannot = grep(!unlink($_), @files);
    #if (@cannot) {
    #    &'AppMsg("object", "unable to delete '@cannot'");
    #}
}

# rename xx.out.ps to xx.ps if FrameMaker 5 is being used to
# generate PostScript
#### OBSOLETE - this is now done inside sdfbatch
sub SdfRenamePS {
    local($xx) = @_;
#   local();
    local($cmd);

    # Do nothing unless FrameMaker 5 is being used
    return unless $'sdf_fmext eq 'fm5';

    # Wait until the print driver has finished
    &'AppMsg("object", "waiting for the print driver\n");
    until (-f "$xx.$out_ext.ps") {
        sleep(1);
        print STDERR ".";
    }
    print STDERR "\n";

    # Rename the file
    $cmd = "/bin/mv $xx.$out_ext.ps  $xx.ps";
    &SdfSystem($cmd);
}

# package return value
1;