1# $Id$
2$VERSION{''.__FILE__} = '$Revision$';
3#
4# >>Title::     SDF Macros Library
5#
6# >>Copyright::
7# Copyright (c) 1992-1996, Ian Clatworthy (ianc@mincom.com).
8# You may distribute under the terms specified in the LICENSE file.
9#
10# >>History::
11# -----------------------------------------------------------------------
12# Date      Who     Change
13# 24-Oct-98 ianc    added jump macro, variables parameter for classes
14# 29-Feb-96 ianc    SDF 2.000
15# -----------------------------------------------------------------------
16#
17# >>Purpose::
18# This library provides the built-in macros (implemented in [[Perl]]) for
19# [[SDF]] files.
20#
21# >>Description::
22# For default values within argument tables:
23#
24# * the empty string means there is no default
25# * the symbol _NULL_ means the default is the empty string.
26#
27# >>Limitations::
28#
29# >>Implementation::
30# The block macros (i.e. block/endblock, macro/endmacro) work as follows:
31#
32# ^ the starting macro sets the following global variables:
33#   - {{$sdf_block_start}} to the current line number
34#   - {{$sdf_block_type}} to {{block}} or {{macro}}
35#   - {{@sdf_block_text}} to empty
36#   - {{%sdf_block_args}} to the arguments
37# + the main parser then builds {{@sdf_block_text}} by searching
38#   until it finds the end of the structure (i.e. the end-style macro
39#   at the same nesting level)
40# + the ending macro then:
41#   - clears {{$sdf_block_type}}
42#   - processes {{@sdf_block_text}} using {{%sdf_block_args}}
43#
44# This strategy minimises the work these macros have to do.
45#
46# The conditional text macros (i.e. if, elsif, etc.) work by changing
47# the following global stacks:
48#
49# * {{@sdf_if_start}} - the starting line number (needed for errors)
50# * {{@sdf_if_now}} - is the current text section to be included?
51# * {{@sdf_if_yet}} - has a section been included yet?
52# * {{@sdf_if_else}} - has the else directive been found yet?
53#
54
55
56# Switch to the user package
57package SDF_USER;
58
59##### Constants #####
60
61@_CLASS_PARAMS = (
62    'Name       Type        Rule',
63    'data       boolean',
64    'cited      boolean',
65    'root       string',
66    'columns    string',
67    'style      string',
68    'compact    boolean',
69    'wide       boolean',
70    'headings   boolean',
71    'where      string',
72    'sort       string',
73    'select     string',
74    'delete     string',
75    'colaligns  string',
76    'colvaligns string',
77    'wrap       integer',
78    'variables  boolean',
79);
80
81##### Variables #####
82
83# Loaded modules
84%_loaded = ();
85
86# User variables, macros, export lookup table
87%var = ();
88%macro = ();
89%export = ();
90
91# Header/footer parts
92%page_hf = ();
93
94# Class definitions
95%_class = ();
96
97# Object properties
98%obj_name = ();
99%obj_long = ();
100
101# Stack of file-related information
102@_file_info = ();
103
104# Subsection prefixes
105%subsection_prefix = ();
106
107# Event data - paragraphs
108@evcode_paragraph = ();
109@evmask_paragraph = ();
110@evid_paragraph = ();
111
112# Event data - phrases
113@evcode_phrase = ();
114@evmask_phrase = ();
115@evid_phrase = ();
116
117# Event data - variables
118@evcode_variable = ();
119@evmask_variable = ();
120@evid_variable = ();
121
122# Event data - macros
123@evcode_macro = ();
124@evmask_macro = ();
125@evid_macro = ();
126
127# Event data - filters
128@evcode_filter = ();
129@evmask_filter = ();
130@evid_filter = ();
131
132# Event data - tables
133@evcode_table = ();
134@evmask_table = ();
135@evid_table = ();
136
137# Lookup table of readonly & restricted variable families
138%restricted = ();
139%readonly = ();
140
141##### Initialisation #####
142
143#
144# >>Description::
145# {{Y:InitMacros}} initialises the global variables in this module.
146#
147sub InitMacros {
148#   local() = @_;
149#   local();
150    local($name);
151
152    %_loaded = ();
153    %var = ();
154    %macro = ();
155    %export = ();
156    %page_hf = ();
157    %_class = ();
158    %obj_name = ();
159    %obj_long = ();
160    @_file_info = ();
161    %subsection_prefix = ();
162
163    @evcode_paragraph = ();
164    @evmask_paragraph = ();
165    @evid_paragraph = ();
166    @evcode_phrase = ();
167    @evmask_phrase = ();
168    @evid_phrase = ();
169    @evcode_variable = ();
170    @evmask_variable = ();
171    @evid_variable = ();
172    @evcode_macro = ();
173    @evmask_macro = ();
174    @evid_macro = ();
175    @evcode_filter = ();
176    @evmask_filter = ();
177    @evid_filter = ();
178    @evcode_table = ();
179    @evmask_table = ();
180    @evid_table = ();
181
182    %readonly = ();
183    %restricted = ();
184    for $name (keys %'sdf_target) {
185        $name =~ tr/a-z/A-Z/;
186        $restricted{$name} = 1;
187    }
188}
189
190##### Support Routines #####
191
192#
193# >>_Description::
194# {{Y:_PageHF}} builds headers or footers.
195# {{type}} is 'HEADER' or 'FOOTER'.
196# If {{overwrite}} is true, the existing header/footer macros are cleared.
197# Otherwise the existing macros are edited.
198# {{pages}} is a comma separated list of page names (i.e. First,Right,Left).
199# {{component}} is the manual component, if any.
200# {{%parts}} is the assocative array of parts within the macro.
201sub _PageHF {
202    local($type, $overwrite, $component, *pages, *parts) = @_;
203    local(@result);
204    local($page, $comp_page);
205    local($mac_name, $mac_value, %mac_parts);
206    local($line, $first, $last);
207    local($posn, @posns);
208    local($sep, $part, $varname);
209
210    # Build the pages
211    for $page (@pages) {
212        $comp_page = $component ne '' ? "\U${component}_$page" : "\U$page";
213        $mac_name = "PAGE_${comp_page}_$type";
214
215        # Get and save the parts within this macro
216        if ($overwrite) {
217            %mac_parts = %parts;
218        }
219        else {
220            %mac_parts = &'SdfAttrSplit($page_hf{$comp_page});
221            @mac_parts{keys %parts} = values %parts;
222        }
223        $page_hf{$comp_page} = &'SdfAttrJoin(*mac_parts);
224
225        # Get the part ordering information
226        $first = 1;
227        $last  = $var{'OPT_HEADINGS'};
228        if ($type eq 'HEADER') {
229            $last = 2 if $last > 2;
230        }
231        elsif ($last > 3) {
232            $first--;
233            $last--;
234        }
235        @posns = "\U$page" eq 'LEFT' ?
236                 ('outer', 'center', 'inner') :
237                 ('inner', 'center', 'outer');
238
239        # Build the macro value
240        $mac_value = $last >= 3 ? "${type}[size='7pt']" : "$type:";
241        $sep = '';
242        for $line ($first .. $last) {
243            for $posn (@posns) {
244                $part = $posn . $line;
245                $varname = $mac_name . "_\U$part";
246                $var{$varname} = $mac_parts{$part};
247                $var{$varname} = '' unless defined $var{$varname};
248                $mac_value .= $sep . '[[' . $varname . ']]';
249                $sep = '[[tab]]';
250            }
251            $sep = '[[nl]]';
252        }
253
254        # Add this macro to the result
255#print STDERR "$mac_name macro is:\n$mac_value\n";
256        push(@result, "!macro $mac_name", $mac_value, "!endmacro");
257    }
258
259    # Return result
260    return @result;
261}
262
263#
264# >>_Description::
265# {{Y:_EventFind}} finds a name in a list of event names.
266# The index of the event is returned, or -1 if the event is
267# not found.
268#
269sub _EventFind {
270    local(*stack, $name) = @_;
271    local($index);
272
273    # Search through the stack of names
274    for ($index = $#stack; $index >= 0; $index--) {
275        return $index if $stack[$index] eq $name;
276    }
277
278    # If we reach here, no luck
279    return -1;
280}
281
282#
283# >>_Description::
284# {{Y:_ClassHandler}} is the implementation for class filters.
285#
286sub _ClassHandler {
287    local($class, *rules, *text, %param) = @_;
288    local(@tbl, @flds, $rec, %values);
289    local($name_style, $name_fld, $long_fld);
290    local($process);
291    local(@out_fields, @out_styles, $out_values);
292    local($field, $style, $value);
293    local($root);
294    local($name, $long, $jump);
295    local($params);
296    local($tbl_style);
297    local($view);
298    local($make_vars, $var_name);
299
300    @tbl = &'TableParse(@text);
301    @text = ();
302    &'TableValidate(*tbl, *rules);
303
304    # Get the class details
305    $name_style = $_class{$class,'name_style'};
306    $name_fld   = $_class{$class,'name_fld'};
307    $long_fld   = $_class{$class,'long_fld'};
308
309    # Get the processing action
310    if ($param{'data'}) {
311        $process = 'data';
312    }
313    elsif ($param{'cited'}) {
314        $process = 'cited';
315    }
316    else {
317        $process = 'display';
318    }
319
320    # Get the 'make variables' flag
321    $make_vars = $param{'variables'};
322    $var_name = '';
323
324    # For display tables, get the fields to be output
325    @out_fields = ();
326    @out_styles = ();
327    if ($process eq 'display') {
328        if ($param{'columns'}) {
329            for $field (split(/,/, $param{'columns'})) {
330                if ($field =~ /^(\w+):(.+)$/) {
331                    push(@out_fields, $2);
332                    push(@out_styles, $1);
333                }
334                else {
335                    push(@out_fields, $field);
336                    push(@out_styles, '');
337                }
338            }
339        }
340        else {
341            @out_fields = ($name_fld, $long_fld);
342            @out_styles = ($name_style, '');
343        }
344    }
345
346    # Process the data
347    (@flds) = &'TableFields(shift @tbl);
348    $root = $param{'root'};
349    for $rec (@tbl) {
350        if ($rec =~ /^!/) {
351            push(@text, $rec);
352            next;
353        }
354        %values = &'TableRecSplit(*flds, $rec);
355
356        # Get the fields of interest
357        $name = $values{$name_fld};
358        $long = $values{$long_fld};
359        $long = $obj_name{$class,$name,$long_fld} if $long eq '';
360        $jump = $values{'Jump'};
361        $jump = $root . $jump if $jump ne '';
362        $jump = $obj_name{$class,$name,'Jump'} if $jump eq '';
363
364        # Convert the name to a legal variable name, if necessary
365        if ($make_vars) {
366            $var_name = $name;
367            $var_name =~ s/\W/_/g;
368        }
369
370        # Store the data - we call an internal macro to do this (rather
371        # than doing it directly) as this approach ensures that macros
372        # embedded in the original data table (e.g. !if) have the
373        # expected effect.
374        $values{'Jump'} = $jump;
375        push(@text, "!_store_ " . join("\000", $class, $process ne 'data',
376            $name_fld, $name, $long_fld, $long, %values));
377        push(@text, "!define $var_name '{{$name_style:$name}}'") if $var_name ne '';
378
379        # For display tables, build the output
380        if ($process eq 'display') {
381            if ($long_fld && $long eq '' && $jump eq '') {
382                &'AppMsg("warning", "unknown object '$name' in class '$class'");
383            }
384            @out_values = ();
385            for ($i = 0; $i <= $#out_fields; $i++) {
386                $field = $out_fields[$i];
387                $style = $out_styles[$i];
388
389                # Get the view, if any.
390                if ($field =~ /^(\w+)\&/) {
391                    $field = $1;
392                    $view = $';
393                }
394                else {
395                    $view = '';
396                }
397
398                # Note: The logic below was originally put there for
399                # speed reasons, I think? However, the introduction of
400                # views means that Value should now always be called.
401                # However, doing that breaks some tests at the moment?
402
403                # Get the value
404                if ($field eq $name_fld) {
405                    $value = $name;
406                }
407                elsif ($field eq $long_fld) {
408                    $value = $long;
409                }
410                elsif (defined($values{$field})) {
411                    $value = $values{$field};
412                }
413                else {
414                    my $ok_class = $class; $ok_class =~ s/['\\]/\\$&/g;
415                    my $ok_name  = $name;  $ok_name  =~ s/['\\]/\\$&/g;
416                    my $ok_field = $field; $ok_field =~ s/['\\]/\\$&/g;
417                    my $ok_view  = $view;  $ok_view  =~ s/['\\]/\\$&/g;
418                    $value = "[[&Value('$ok_class', '$ok_name', '$ok_field', '$ok_view')]]";
419                }
420
421                # Apply the format or style
422                if ($style ne '') {
423                    if (defined($var{"FORMAT_$style"})) {
424                        if (substr($value, 0, 2) eq '[[') {
425                            $value = "[[$style:" . substr($value, 2);
426                        }
427                        else {
428                            $value = "[[$style:$value]]";
429                        }
430                    }
431                    else {
432                        $params = $view ? "[view='$view']" : ":";
433                        $value = "{{$style$params$value}}";
434                    }
435                }
436
437                push(@out_values, $value);
438            }
439            push(@text, join("~", @out_values));
440        }
441    }
442
443    # Build the field parsing line.
444    # We replace the & with a _ within the field name so that
445    # column name parsing doesn't screw up if views are specified.
446    my $fields_heading = join("~", @out_fields);
447    $fields_heading =~ tr/&/_/;
448
449    # For display tables, finish generating the table
450    if ($process eq 'display') {
451        $tbl_style = $param{'style'} ? $param{'style'} : 'plain';
452        $params = "style='$tbl_style'";
453        $params .= "; cellpadding=0; cellspacing=0" if $param{'compact'};
454        $params .= "; wide" if $param{'wide'};
455        $params .= "; noheadings" unless $param{'headings'};
456        $params .= "; where='$param{'where'}'" if $param{'where'} ne '';
457        $params .= "; sort='$param{'sort'}'" if $param{'sort'} ne '';
458        $params .= "; select='$param{'select'}'" if $param{'select'} ne '';
459        $params .= "; delete='$param{'delete'}'" if $param{'delete'} ne '';
460        $params .= "; colaligns='$param{'colaligns'}'" if $param{'colaligns'} ne '';
461        $params .= "; colvaligns='$param{'colvaligns'}'" if $param{'colvaligns'} ne '';
462        $params .= "; wrap='$param{'wrap'}'" if $param{'wrap'} ne '';
463        unshift(@text,
464          "!block table; $params",
465          $fields_heading);
466        push(@text, "!endblock");
467    }
468#printf STDERR "%s<\n", join("<\n", @text);
469}
470
471#
472# >>_Description::
473# {{Y:_ObjectNameEP}} is the event processing for objects in a class.
474#
475sub _ObjectNameEP {
476    local($class, $long_style, $long_fld) = @_;
477
478    # Validate the object
479    if (! $obj_name{$class,$text}) {
480        &'AppMsg("warning", "unknown object '$text' in class '$class' (name EP)");
481    }
482
483    # Generate the hypertext, if any
484    if ($attr{'jump'} eq '' && defined $obj_name{$class,$text,'Jump'}) {
485        $attr{'jump'} = $obj_name{$class,$text,'Jump'};
486    }
487
488    # Expand the object name, if requested
489    if ($attr{'expand'}) {
490        delete $attr{'expand'};
491        if ($long_fld && $obj_name{$class,$text,$long_fld} ne '') {
492            $style = $long_style if $long_style ne '';
493            $text = $obj_name{$class,$text,$long_fld};
494        }
495        else {
496            &'AppMsg("warning", "unable to expand object '$text' in class '$class'");
497        }
498    }
499
500    # Cite the object number, if requested
501    elsif ($attr{'cite'}) {
502        delete $attr{'cite'};
503        $style = 'N';
504        $text = &Value($class, $text, 'Cite', $attr{'view'});
505    }
506}
507
508#
509# >>_Description::
510# {{Y:_ObjectLongEP}} is the event processing for object long names in a class.
511#
512sub _ObjectLongEP {
513    local($class, $name_style, $name_fld) = @_;
514
515    # Validate the object
516    if (! $obj_long{$class,$text}) {
517        &'AppMsg("warning", "unknown object '$text' in class '$class' (long EP)");
518    }
519
520    # Generate the hypertext, if any
521    if ($attr{'jump'} eq '' && defined $obj_long{$class,$text,'Jump'}) {
522        $attr{'jump'} = $obj_long{$class,$text,'Jump'};
523    }
524
525    # Shrink the object name, if requested
526    if ($attr{'shrink'}) {
527        delete $attr{'shrink'};
528        if ($obj_long{$class,$text,$name_fld} ne '') {
529            $style = $name_style;
530            $text = $obj_long{$class,$text,$name_fld};
531        }
532        else {
533            &'AppMsg("warning", "unable to shrink object '$text' in class '$class'");
534        }
535    }
536
537    # Cite the object number, if requested
538    elsif ($attr{'cite'}) {
539        delete $attr{'cite'};
540        $style = 'N';
541        $text = &Value($class, $text, 'Cite', $attr{'view'});
542    }
543}
544
545##### General Macros #####
546
547# block - begin a block of text
548@_block_MacroArgs = (
549    'Name       Type        Default     Rule',
550    'filter     filter',
551    'params     rest        _NULL_',
552);
553sub block_Macro {
554    local(%arg) = @_;
555    local(@text);
556#print STDERR "sb1 file: $'ARGV, lineno: $'app_lineno<\n";
557
558    # Update the parser state
559    $'sdf_block_start = $'app_lineno;
560    $'sdf_block_type = 'block';
561    @'sdf_block_text = ();
562    %'sdf_block_arg = %arg;
563
564    # Return result
565    return ();
566}
567
568# endblock - end a block of text
569@_endblock_MacroArgs = ();
570sub endblock_Macro {
571    local(%arg) = @_;
572    local(@text);
573
574    # Check the state
575    if ($'sdf_block_type ne 'block') {
576        &'AppMsg("error", "endblock macro not expected");
577        return ();
578    }
579
580    # Update the parser state
581    $'sdf_block_type = '';
582
583    # Filter the text
584    &ExecFilter($'sdf_block_arg{'filter'}, *'sdf_block_text,
585      $'sdf_block_arg{'params'}, $'sdf_block_start, $'ARGV, 'filter on ');
586
587    # Mark the text as a section, if necessary
588    if (@'sdf_block_text) {
589        unshift(@'sdf_block_text,
590          "!_bos_ $'sdf_block_start;block on ");
591        push(@'sdf_block_text, "!_eos_ $'app_lineno;$'app_context");
592    }
593
594    # Return result
595    return @'sdf_block_text;
596}
597
598# include - include another file
599@_include_MacroArgs = (
600    'Name       Type        Default     Rule',
601    'filename   string',
602    'filter     filter      _NULL_',
603    'params     rest        _NULL_',
604);
605sub include_Macro {
606    local(%arg) = @_;
607    local(@text);
608    local($filename, $fullname);
609    local($outfile);
610
611    # Get the file location
612    $filename = $arg{'filename'};
613    $fullname = &FindFile($filename);
614    if ($fullname eq '') {
615        &'AppMsg("warning", "unable to find '$filename'");
616        return ();
617    }
618
619    # Get the text
620    unless (&FileFetch(*text, $fullname)) {
621        &'AppMsg("warning", "unable to read '$fullname'");
622        return ();
623    }
624
625    # Filter the text
626    &ExecFilter($arg{'filter'}, *text, $arg{'params'});
627
628    # Return result
629    return ("!_bof_ '$fullname'", @text, "!_eof_");
630}
631
632# use - load a library module
633@_use_MacroArgs = (
634    'Name       Type        Default     Rule',
635    'filename   string',
636    'filter     filter      sdf',
637    'params     rest        _NULL_',
638);
639sub use_Macro {
640    local(%arg) = @_;
641    local(@text);
642    local($filename, $fullname);
643
644    # Add the sdm extension, if there is none
645    $filename = $arg{'filename'};
646    $filename .= ".sdm" unless $filename =~ /\.\w+$/;
647
648    # Get the file location
649    $fullname = &FindModule($filename);
650    if ($fullname eq '') {
651        &'AppMsg("warning", "unable to find '$filename'");
652        return ();
653    }
654
655    # If already loaded, do nothing
656    return () if $_loaded{$fullname};
657
658    # Get the text
659    unless (&FileFetch(*text, $fullname)) {
660        &'AppMsg("warning", "unable to read '$fullname'");
661        return ();
662    }
663
664    # Mark the library as loaded
665    $_loaded{$fullname} = 1;
666
667    # Filter the text
668    &ExecFilter($arg{'filter'}, *text, $arg{'params'});
669
670    # Return result
671    return ("!_bof_ '$fullname'", @text, "!_eof_");
672}
673
674# inherit - load a library
675@_inherit_MacroArgs = (
676    'Name       Type        Default     Rule',
677    'library    string',
678);
679sub inherit_Macro {
680    local(%arg) = @_;
681    local(@text);
682    local($library, $dos_library);
683    local($module);
684
685    # Add the library to the include and module paths
686    $library = $arg{'library'};
687    $dos_library = $library;
688    $dos_library =~ s#/#\\#g;
689    $module = (&'NameSplit($library))[1];
690    if (-f "$module.sdm") {
691        # Module is in the current directory
692        $library = '.';
693    }
694    elsif (&'NameIsAbsolute($library)) {
695        push(@include_path, $library);
696        push(@module_path, $library);
697        $var{'HLP_OPTIONS_ROOT'} .= ", $dos_library";
698    }
699    else {
700        my $lib_dir = &FindLibrary($library);
701        if ($lib_dir ne '') {
702            push(@include_path, $lib_dir);
703            push(@module_path, $lib_dir);
704            $var{'HLP_OPTIONS_ROOT'} .= ", $var{'SDF_DOSHOME'}\\$dos_library";
705        }
706        else {
707            &'AppMsg("warning", "unable to find library '$library'");
708            return ();
709        }
710    }
711
712    # Load the matching module
713    @text = ("!use '$library/$module'");
714
715    # Return result
716    return @text;
717}
718
719# execute - include output from a command
720@_execute_MacroArgs = (
721    'Name       Type        Default     Rule',
722    'cmd        string',
723    'filter     filter      sdf',
724    'params     rest        _NULL_',
725);
726sub execute_Macro {
727    local(%arg) = @_;
728    local(@text);
729    local($cmd);
730
731    # Get the text
732    $cmd = $arg{'cmd'};
733    unless (&FileFetch(*text, "$cmd|")) {
734        &'AppMsg("error", "failed to execute '$cmd'");
735        return ();
736    }
737
738    # Filter the text
739    #&ExecFilter($arg{'filter'}, *text, $arg{'params'}, 0, "'$cmd'", 'line ');
740    &ExecFilter($arg{'filter'}, *text, $arg{'params'});
741
742    # Return result
743    return ("!_bof_ '$cmd'", @text, "!_eof_");
744}
745
746# import - import an object (e.g. figure) from another package
747@_import_MacroArgs = (
748    'Name       Type        Default     Rule',
749    'filename   string',
750    'params     rest        _NULL_',
751);
752sub import_Macro {
753    local(%arg) = @_;
754#   local(@text);
755    local($filename);
756    local(%params);
757
758    # Process the filename and attributes
759    $filename = $arg{'filename'};
760    %params = &'SdfAttrSplit($arg{'params'});
761    &ProcessImageAttrs(*filename, *params);
762
763    # Return result
764    return (&'SdfJoin('__import', $filename, %params));
765}
766
767# jumps - create jump lines
768@_jumps_MacroArgs = (
769    'Name       Type        Default     Rule',
770    'labels     string',
771    'layout     string      Center      <Left|Center|Right|left|center|right>',
772);
773sub jumps_Macro {
774    local(%arg) = @_;
775    local(@text);
776    local(@subs, $sub, $jump);
777    local($sep);
778    local($layout);
779
780    # Build the jumps
781    @subs = split(/,/, $arg{'labels'});
782    $sep = '';
783    for $sub (@subs) {
784        if ($sub eq '') {
785            $sub = "{{CHAR:nl}}";
786            $sep = '';
787        }
788        else {
789            $jump = &TextToId($sub);
790            $sub = $sep . "{{[jump='#$jump']$sub}}";
791            $sep = ' | ';
792        }
793    }
794
795    # Build the output
796    @text = ();
797    $layout = $arg{'layout'};
798    substr($layout, 0, 1) =~ tr/a-z/A-Z/;
799    @text = ("[align='$layout']" . join("", @subs));
800
801    # Return result
802    return @text;
803}
804
805# subsections - list topic subsections (and create a jump line for HTML)
806@_subsections_MacroArgs = (
807    'Name       Type        Default     Rule',
808    'labels     string',
809    'prefix     string      Topic       <Topic|Noprefix|noprefix>',
810    'layout     string      Left        <Left|Center|Right|None|left|center|right|none>',
811);
812sub subsections_Macro {
813    local(%arg) = @_;
814    local(@text);
815    local(@subs, $sub, $jump);
816    local($prefix);
817    local($sep);
818    local($layout);
819
820    # Get the list of subsections
821    @subs = split(/,/, $arg{'labels'});
822
823    # Get the prefix, if any
824    $prefix = '';
825    if ($arg{'prefix'} eq 'Topic') {
826        $prefix = $topic ne '' ? "$topic - " : '';
827    }
828
829    # Save the sub-section data and build the jumps
830    $sep = '';
831    for $sub (@subs) {
832        if ($sub eq '') {
833            $sub = "{{CHAR:nl}}";
834            $sep = '';
835        }
836        else {
837            $subsection_prefix{$sub} = $prefix;
838            $jump = &TextToId($prefix . $sub);
839            $sub = $sep . "{{[jump='#$jump']$sub}}";
840            $sep = ' | ';
841        }
842    }
843
844    # Build the output (HTML only for now)
845    @text = ();
846    if ($var{'OPT_TARGET'} eq 'html') {
847        $layout = $arg{'layout'};
848        substr($layout, 0, 1) =~ tr/a-z/A-Z/;
849        if ($layout ne 'None') {
850            @text = ("[align='$layout']" . join("", @subs));
851        }
852    }
853
854    # Return result
855    return @text;
856}
857
858# continued - continue a heading onto another page
859@_continued_MacroArgs = (
860    'Name       Type        Default             Rule',
861    'style      string',
862    'suffix     string      , {{N:Continued}}',
863);
864sub continued_Macro {
865    local(%arg) = @_;
866    local(@text);
867    local($target);
868    local($style, $suffix);
869
870    # Build result
871    $target = $var{'OPT_TARGET'};
872    if ($target eq 'html' || $target eq 'hlp') {
873        @text = ();
874    }
875    else {
876        $style = $arg{'style'};
877        $suffix = $arg{'suffix'};
878        @text = $style . "[notoc;noid;continued][[&Previous($style)]]$suffix";
879    }
880
881    # Return result
882    return @text;
883}
884
885# clear - insert a BR CLEAR for HTML
886@_clear_MacroArgs = (
887    'Name       Type        Default     Rule',
888    'type       string      All         <Left|Right|All>',
889);
890sub clear_Macro {
891    local(%arg) = @_;
892    local(@text);
893
894    # Build the result
895    if ($var{'OPT_TARGET'} eq 'html') {
896        @text = (
897            "!block inline",
898            "<BR CLEAR=\"" . $arg{'type'} . '">',
899            "!endblock");
900    }
901    else {
902        @text = ();
903    }
904
905    # Return result
906    return @text;
907}
908
909# catalog - build a catalog of the objects already loaded for a class
910@_catalog_MacroArgs = (
911    'Name       Type        Default     Rule',
912    'class      symbol',
913    'mask       string',
914    'params     rest        _NULL_',
915);
916sub catalog_Macro {
917    local(%arg) = @_;
918    local(@text);
919    local($class, $name_fld);
920    local($object, $mask);
921
922    # Get the class and its name field
923    $class    = $arg{'class'};
924    $name_fld = $_class{$class,'name_fld'};
925
926    # Build the output header
927    @text = ("!block $class; $arg{'params'}", $name_fld);
928
929    # Build the result
930    $mask = $arg{'mask'};
931    if ($mask eq 'cited') {
932        for $object (split("\n", $_class{$class,'cited'})) {
933            push(@text, $object);
934        }
935    }
936    elsif ($mask =~ /^(\w+):/) {
937        my $attr = $1;
938        $mask = $';
939        my $value;
940        for $object (split("\n", $_class{$class,'catalog'})) {
941            $value = &Value($class, $object, $attr);
942            next if $mask ne '' && $value !~ /^$mask$/;
943            push(@text, $object);
944        }
945    }
946    else {
947        for $object (split("\n", $_class{$class,'catalog'})) {
948            next if $mask ne '' && $object !~ /^$mask$/;
949            push(@text, $object);
950        }
951    }
952    push(@text, "!endblock");
953
954    # Return result
955    return @text;
956}
957
958# namevalues - insert a set of object attributes using a namevalues filter
959@_namevalues_MacroArgs = (
960    'Name       Type        Default     Rule',
961    'class      string',
962    'object     string',
963    'attributes string',
964    'params     rest        _NULL_',
965);
966sub namevalues_Macro {
967    local(%arg) = @_;
968    local(@text);
969    local($class, $object, @attrs, $attr);
970
971    # Get the details
972    $class = $arg{'class'};
973    $object = $arg{'object'};
974    @attrs = sort split(/,/, $arg{'attributes'});
975
976    # Build result
977    @text = ("!block namevalues; $arg{'params'}", "Name|Value");
978    for $attr (@attrs) {
979        push(@text, "$attr:|" . &Value($class, $object, $attr));
980    }
981    push(@text, "!endblock");
982
983    # Return result
984    return @text;
985}
986
987##### Variables Macros #####
988
989# define - define a variable
990@_define_MacroArgs = (
991    'Name       Type        Default     Rule',
992    'name       symbol',
993    'value      string      1',
994);
995sub define_Macro {
996    local(%arg) = @_;
997    local(@text);
998    local($name, $value);
999    local($type, $rule);
1000
1001    # Get the name and value
1002    $name = $arg{'name'};
1003    $value = $arg{'value'};
1004
1005    ## If the variable looks like an enum, output an error
1006    #if ($name =~ /^[A-Z][a-z]+$/) {
1007    #    &'AppMsg("error", "'variable '$name' looks like an enumerated value");
1008    #    return ();
1009    #}
1010
1011    # If the variable is in a family, check it has been declared
1012    if ($name =~ /^([A-Z]+)_/ && $restricted{$1} &&
1013      !$variables_name{$name}) {
1014        $status = (defined($var{$name}) || $readonly{$1}) ? 'read-only' : 'unknown';
1015        &'AppMsg("warning", "'$1' variable '$name' is $status - ignoring definition");
1016        return ();
1017    }
1018
1019    # If the variable has been declared, validate it
1020    if ($variables_name{$name}) {
1021        $type = $variables_type{$name};
1022        $rule = $variables_rule{$name};
1023        unless (&'MiscCheckRule($value, $rule, $type)) {
1024            &'AppMsg("warning", "bad value '$value' for variable '$name'");
1025        }
1026    }
1027
1028    # Save the definition
1029    $var{$name} = $value;
1030
1031    # Export the variable, if necessary
1032    if ($export{$name}) {
1033        @text = (&'SdfJoin('__object', 'Variable',
1034                'Name',  $name,
1035                'value', $value));
1036    }
1037
1038    # Return result
1039    return (@text);
1040}
1041
1042# default - define a variable (if not already set)
1043@_default_MacroArgs = (
1044    'Name       Type        Default     Rule',
1045    'name       symbol',
1046    'value      string      1',
1047);
1048sub default_Macro {
1049    local(%arg) = @_;
1050    local(@text);
1051    local($name);
1052
1053    $name = $arg{'name'};
1054
1055    # Save the definition, if necessary
1056    &define_Macro(%arg) unless defined($var{$name});
1057
1058    # Return result
1059    return ();
1060}
1061
1062# undef - undefine a variable
1063@_undef_MacroArgs = (
1064    'Name       Type        Default     Rule',
1065    'name       symbol',
1066);
1067sub undef_Macro {
1068    local(%arg) = @_;
1069    local(@text);
1070
1071    # Clear the definition
1072    delete $var{$arg{'name'}};
1073
1074    # Return result
1075    return ();
1076}
1077
1078# init - initialise a set of variables
1079@_init_MacroArgs = (
1080    'Name       Type        Default     Rule',
1081    'vars       rest        _NULL_',
1082);
1083sub init_Macro {
1084    local(%arg) = @_;
1085    local(@text);
1086    local(%vars, $name, $value);
1087
1088    # Convert the name-value pairs to define macros
1089    %vars = &'SdfAttrSplit($arg{'vars'});
1090    for $name (sort keys %vars) {
1091        $value = $vars{$name};
1092        $value =~ s/'/\\'/g;
1093        push(@text, "!default $name '$value'");
1094    }
1095
1096    # Return result
1097    return @text;
1098}
1099
1100# export - mark a variable for export
1101@_export_MacroArgs = (
1102    'Name       Type        Default     Rule',
1103    'name       symbol',
1104);
1105sub export_Macro {
1106    local(%arg) = @_;
1107    local(@text);
1108    local($name);
1109
1110    # Mark for export
1111    $name = $arg{'name'};
1112    $export{$name} = 1;
1113
1114    # If already defined, export it immediately
1115    if (defined $var{$name}) {
1116        @text = (&'SdfJoin('__object', 'Variable',
1117                'Name',  $name,
1118                'value', $var{$name}));
1119    }
1120
1121    # Return result
1122    return @text;
1123}
1124
1125##### Configuration Macros #####
1126
1127# macro - begin a macro definition
1128@_macro_MacroArgs = (
1129    'Name       Type        Default     Rule',
1130    'name       symbol',
1131);
1132sub macro_Macro {
1133    local(%arg) = @_;
1134    local(@text);
1135
1136    # Update the parser state
1137    $'sdf_block_start = $'app_lineno;
1138    $'sdf_block_type = 'macro';
1139    @'sdf_block_text = ();
1140    %'sdf_block_arg = %arg;
1141
1142    # Return result
1143    return ();
1144}
1145
1146# endmacro - end a macro definition
1147@_endmacro_MacroArgs = ();
1148sub endmacro_Macro {
1149    local(%arg) = @_;
1150    local(@text);
1151
1152    # Check the state
1153    if ($'sdf_block_type ne 'macro') {
1154        &'AppMsg("error", "endmacro macro not expected");
1155        return ();
1156    }
1157
1158    # Update the parser state
1159    $'sdf_block_type = '';
1160
1161    # Save the definition
1162    $macro{$'sdf_block_arg{'name'}} = join("\n", @'sdf_block_text);
1163
1164    # Return result
1165    return ();
1166}
1167
1168# class - declare a class of objects
1169@_class_MacroArgs = (
1170    'Name       Type        Default         Rule',
1171    'name       symbol',
1172    'styles     string',
1173    'ids        string      Name,Long',
1174    'properties string      Jump',
1175);
1176sub class_Macro {
1177    local(%arg) = @_;
1178    local(@text);
1179    local($name);
1180    local($name_style, $long_style);
1181    local($name_fld, $long_fld);
1182    local($fld, @rest, @rules);
1183    local($code);
1184
1185    # Store the class details
1186    $name = $arg{'name'};
1187    ($name_style, $long_style) = split(/,/, $arg{'styles'});
1188    ($name_fld,   $long_fld)   = split(/,/, $arg{'ids'});
1189    $_class{$name} = 1;
1190    $_class{$name,'name_style'} = $name_style;
1191    $_class{$name,'long_style'} = $long_style;
1192    $_class{$name,'name_fld'} = $name_fld;
1193    $_class{$name,'long_fld'} = $long_fld;
1194    $_class{$name,'properties'}  = $arg{'properties'};
1195
1196    # Build the rules table
1197    ($fld, @rest) = split(/,/, $arg{'ids'});
1198    push(@rest, split(/,/, $arg{'properties'}));
1199    @rules = ('Field:Category:Rule', "$fld:mandatory");
1200    push(@rules, "$fld:optional") while ($fld = shift(@rest));
1201
1202    # Build the filter
1203    $code = <<end_of_code;
1204        \@_${name}_FilterParams = \@_CLASS_PARAMS;
1205        \@_${name}_FilterModel = &'TableParse(\@rules);
1206        sub ${name}_Filter {
1207            local(*text, %param) = \@_;
1208
1209            &_ClassHandler('$name', *_${name}_FilterModel, *text, %param);
1210        }
1211end_of_code
1212
1213    # Create the filter
1214    eval $code;
1215    if ($@) {
1216        &'AppMsg("error", "filter creation failed: $@");
1217    }
1218
1219    # Declare the object styles
1220    @text = ("!block phrasestyles", "Name", $name_style);
1221    push(@text, $long_style) if $long_style ne '';
1222    push(@text, "!endblock");
1223
1224    # Declare the event processing
1225    push(@text, "!on phrase '$name_style';;" .
1226      "&_ObjectNameEP('$name', '$long_style', '$long_fld')");
1227    push(@text, "!on phrase '$long_style';;" .
1228      "&_ObjectLongEP('$name', '$name_style', '$name_fld')") if $long_style;
1229
1230    # Return result
1231    return @text;
1232}
1233
1234# restrict - declare a restricted variable family
1235@_restrict_MacroArgs = (
1236    'Name       Type        Default     Rule',
1237    'name       string',
1238);
1239sub restrict_Macro {
1240    local(%arg) = @_;
1241    local(@text);
1242
1243    $restricted{$arg{'name'}} = 1;
1244    return ();
1245}
1246
1247# readonly - declare a readonly variable family
1248@_readonly_MacroArgs = (
1249    'Name       Type        Default     Rule',
1250    'name       string',
1251);
1252sub readonly_Macro {
1253    local(%arg) = @_;
1254    local(@text);
1255
1256    $readonly{$arg{'name'}} = 1;
1257    return ();
1258}
1259
1260# path_prepend - prepend a directory to the search path
1261@_path_prepend_MacroArgs = (
1262    'Name       Type        Default     Rule',
1263    'dir        string',
1264);
1265sub path_prepend_Macro {
1266    local(%arg) = @_;
1267    local(@text);
1268    local($dir);
1269
1270    $dir = $arg{'dir'};
1271    unshift(@include_path, $dir) unless $include_path[0] eq $dir;
1272    return ();
1273}
1274
1275# path_append - append a directory to the search path
1276@_path_append_MacroArgs = (
1277    'Name       Type        Default     Rule',
1278    'dir        string',
1279);
1280sub path_append_Macro {
1281    local(%arg) = @_;
1282    local(@text);
1283    local($dir);
1284
1285    $dir = $arg{'dir'};
1286    push(@include_path, $dir) unless $include_path[$#include_path] eq $dir;
1287    return ();
1288}
1289
1290# script - execute a Perl script
1291@_script_MacroArgs = (
1292    'Name       Type        Default     Rule',
1293    'code       rest',
1294);
1295sub script_Macro {
1296    local(%arg) = @_;
1297    local(@text);
1298
1299    # execute the code
1300    eval $arg{'code'};
1301    if ($@) {
1302        &'AppMsg("error", "script failed: $@");
1303    }
1304
1305    # Return result
1306    return ();
1307}
1308
1309# targetobject - define a target object
1310@_targetobject_MacroArgs = (
1311    'Name       Type        Default     Rule',
1312    'type       string',
1313    'name       string',
1314    'parent     string      _NULL_',
1315    'attributes rest        _NULL_',
1316);
1317sub targetobject_Macro {
1318    local(%arg) = @_;
1319    local(@text);
1320    local($type, $name, $parent, $attrs);
1321
1322    # Get the defails
1323    $type = $arg{'type'};
1324    $name = $arg{'name'};
1325    $parent = $arg{'parent'};
1326    $attrs = $arg{'attributes'};
1327
1328    # Return result (efficiently)
1329    return ("__object[Name='$name';Parent='$parent';$attrs]$type");
1330}
1331
1332# div - begin a division
1333@_div_MacroArgs = (
1334    'Name       Type        Default     Rule',
1335    'name       symbol',
1336);
1337sub div_Macro {
1338    local(%arg) = @_;
1339    local(@text);
1340
1341    # Update the parser state
1342    # to do ...
1343
1344    # Return result
1345    return (&'SdfJoin("__div", $arg{'name'}, ()));
1346}
1347
1348# enddiv - end a macro definition
1349@_enddiv_MacroArgs = ();
1350sub enddiv_Macro {
1351    local(%arg) = @_;
1352    local(@text);
1353
1354    ## Check the state
1355    #if ($'sdf_block_type ne 'macro') {
1356    #    &'AppMsg("warning", "enddiv macro not expected");
1357    #    return ();
1358    #}
1359
1360    # Return result
1361    return (&'SdfJoin("__enddiv", "", ()));
1362}
1363
1364
1365##### Conditional Text Macros #####
1366
1367# if - begin conditional text
1368@_if_MacroArgs = (
1369    'Name       Type        Default     Rule',
1370    'value      condition',
1371);
1372sub if_Macro {
1373    local(%arg) = @_;
1374    local(@text);
1375    local($expr_value);
1376
1377    # If we are nested inside a section of an if macro which is not
1378    # to be included, we exclude all sections of this macro.
1379    push(@'sdf_if_start, $'app_lineno);
1380    if (@'sdf_if_now && ! $'sdf_if_now[$#main'sdf_if_now]) {
1381        push(@'sdf_if_now, 0);
1382        push(@'sdf_if_yet, 1);
1383        push(@'sdf_if_else, 0);
1384    }
1385
1386    # Otherwise, evaluate the expression and process accordingly.
1387    else {
1388        $expr_value = $arg{'value'};
1389        push(@'sdf_if_now, $expr_value);
1390        push(@'sdf_if_yet, $expr_value);
1391        push(@'sdf_if_else, 0);
1392    }
1393
1394    # Return result
1395    return ();
1396}
1397
1398# elsif - begin a conditional section within conditional text
1399@_elsif_MacroArgs = (
1400    'Name       Type        Default     Rule',
1401    'value      condition',
1402);
1403sub elsif_Macro {
1404    local(%arg) = @_;
1405    local(@text);
1406    local($level);
1407    local($expr_value);
1408
1409    # elsif not permitted outside an if macro
1410    unless (@'sdf_if_now) {
1411        &'AppMsg("error", "!elsif not expected");
1412        return ();
1413    }
1414
1415    # Get the current nesting level
1416    $level = $#main'sdf_if_yet;
1417
1418    # elsif after an else is not permitted
1419    if ($'sdf_if_else[$level]) {
1420        &'AppMsg("error", "!elsif found after else macro");
1421        return ();
1422    }
1423
1424    # Only evaluate the expression if we haven't included a section yet
1425    if (! $'sdf_if_yet[$level]) {
1426        $expr_value = $arg{'value'};
1427        $'sdf_if_now[$level] = $expr_value;
1428        $'sdf_if_yet[$level] = $expr_value;
1429    }
1430    else {
1431        $'sdf_if_now[$level] = 0;
1432    }
1433
1434    # Return result
1435    return ();
1436}
1437
1438# elseif - begin a conditional section within conditional text
1439@_elseif_MacroArgs = @_elsif_MacroArgs;
1440sub elseif_Macro {
1441    local(%arg) = @_;
1442    local(@text);
1443
1444    return &elsif_Macro(%arg);
1445}
1446
1447# else - begin an else section within conditional text
1448@_else_MacroArgs = ();
1449sub else_Macro {
1450    local(%arg) = @_;
1451    local(@text);
1452    local($level);
1453
1454    # else not permitted outside an if macro
1455    unless (@'sdf_if_now) {
1456        &'AppMsg("error", "!else not expected");
1457        return ();
1458    }
1459
1460    # Get the current nesting level
1461    $level = $#main'sdf_if_yet;
1462
1463    # record that we have encountered the else
1464    # (this is needed for checking that an elsif does not follow it)
1465    $'sdf_if_else[$level] = 1;
1466
1467    # Only include this section if we haven't included a section yet
1468    if (! $'sdf_if_yet[$level]) {
1469        $'sdf_if_now[$level] = 1;
1470        $'sdf_if_yet[$level] = 1;
1471    }
1472    else {
1473        $'sdf_if_now[$level] = 0;
1474    }
1475
1476    # Return result
1477    return ();
1478}
1479
1480# endif - end conditional text
1481@_endif_MacroArgs = ();
1482sub endif_Macro {
1483    local(%arg) = @_;
1484    local(@text);
1485
1486    # endif not permitted outside an if macro
1487    unless (@'sdf_if_now) {
1488        &'AppMsg("error", "!endif not expected");
1489        return ();
1490    }
1491
1492    pop(@'sdf_if_start);
1493    pop(@'sdf_if_now);
1494    pop(@'sdf_if_yet);
1495    pop(@'sdf_if_else);
1496
1497    # Return result
1498    return ();
1499}
1500
1501##### Looping Macros #####
1502
1503# for - begin a loop
1504@_for_MacroArgs = (
1505    'Name       Type        Default     Rule',
1506    'name       symbol',
1507    'values     rest',
1508);
1509sub for_Macro {
1510    local(%arg) = @_;
1511    local(@text);
1512
1513    # Return result
1514    return ();
1515}
1516
1517# endfor - end loop
1518@_endfor_MacroArgs = ();
1519sub endfor_Macro {
1520    local(%arg) = @_;
1521    local(@text);
1522
1523    # Return result
1524    @text = ();
1525    return @text;
1526}
1527
1528##### Table Macros #####
1529
1530# table - begin a table
1531@_table_MacroArgs = (
1532    'Name       Type        Default     Rule',
1533    'columns    integer',
1534    'params     rest        _NULL_',
1535);
1536sub table_Macro {
1537    local(%arg) = @_;
1538    local(@text);
1539    local(@format, $format);
1540    local($lower, $sep, $upper);
1541    local(%param);
1542    local($col, $unspecified);
1543
1544    # Update the state
1545    push(@'sdf_tbl_state, 1);
1546    push(@'sdf_tbl_start, $'app_lineno);
1547
1548    # Validate and clean the parameters
1549    %param = &SdfTableParams('table', $arg{'params'}, *tableparams_name,
1550      *tableparams_type, *tableparams_rule);
1551
1552    # Use the default style, if necessary
1553    $param{'style'} = &Var('DEFAULT_TABLE_STYLE') if $param{'style'} eq '';
1554
1555    # Expand the format attribute to make processing within the driver
1556    # routines easier:
1557    # * % is appended for percentages
1558    # * '*' is expanded to '1*'
1559    # * '-' is expanded to '0%-100%' (likewise for =)
1560    # * '-d' is expanded to '0%-d' (likewise for =)
1561    # * 'd-' is expanded to 'd-100%' (likewise for =)
1562    # * defaults are applied for unspecified widths:
1563    #   - the last unspecified width is 1* (or 0%-100% for narrow tables)
1564    #   - other unspecified widths are 0%-100%.
1565    @format = ();
1566    if ($param{'format'} =~ /^\d+$/) {
1567        for $format (split(//, $param{'format'})) {
1568            push(@format, $format * 10 . "%");
1569        }
1570    }
1571    else {
1572        for $format (split(/\s*,\s*/, $param{'format'})) {
1573            if ($format =~ /^\d+$/) {
1574                $format .= '%';
1575            }
1576            elsif ($format eq '*') {
1577                $format = "1*";
1578            }
1579            elsif ($format =~ /([-=])/) {
1580                $lower = $` eq '' ? '0%' : $`;
1581                $sep   = $1;
1582                $upper = $' eq '' ? '100%' : $';
1583                $lower .= '%' if $lower =~ /^\d+$/;
1584                $upper .= '%' if $upper =~ /^\d+$/;
1585                $format = "$lower$sep$upper";
1586            }
1587            push(@format, $format);
1588        }
1589    }
1590    $unspecified = $param{'narrow'} ? '0%-100%' : '1*';
1591    for ($col = $arg{'columns'} - 1; $col >= 0; $col--) {
1592        if ($format[$col] eq '') {
1593            $format[$col] = $unspecified;
1594            $unspecified = '0%-100%';
1595        }
1596    }
1597    $param{'format'} = join(",", @format);
1598    delete $param{'narrow'};
1599
1600    # Build the result
1601    @text = (&'SdfJoin("__table", $arg{'columns'}, %param));
1602
1603    # Return result
1604    return @text;
1605}
1606
1607# row - begin a table row
1608@_row_MacroArgs = (
1609    'Name       Type        Default     Rule',
1610    'type       string      Body        <Body|Heading|Footing|Group>',
1611    'params     rest        _NULL_',
1612);
1613sub row_Macro {
1614    local(%arg) = @_;
1615    local(@text);
1616    local(%param);
1617
1618    # Check the state
1619    unless (@'sdf_tbl_state) {
1620        &'AppMsg("error", "!row not expected");
1621        return ();
1622    }
1623
1624    # For performance, handle the empty parameters case first
1625    return ('__row[]Body') unless $arg{'type'}.$arg{'params'};
1626
1627    # Validate and clean the parameters
1628    %param = &SdfTableParams('row', $arg{'params'}, *rowparams_name,
1629      *rowparams_type, *rowparams_rule);
1630
1631    # Build the result
1632    @text = (&'SdfJoin("__row", $arg{'type'}, %param));
1633
1634    # Return result
1635    return @text;
1636}
1637
1638# cell - begin a table cell
1639@_cell_MacroArgs = (
1640    'Name       Type        Default     Rule',
1641    'params     rest        _NULL_',
1642);
1643sub cell_Macro {
1644    local(%arg) = @_;
1645    local(@text);
1646    local(%param);
1647
1648    # Check the state
1649    unless (@'sdf_tbl_state) {
1650        &'AppMsg("error", "!cell not expected");
1651        return ();
1652    }
1653
1654    # For performance, handle the empty parameters case first
1655    return ('__cell[]') if $arg{'params'} eq '';
1656
1657    # Validate and clean the parameters
1658    %param = &SdfTableParams('cell', $arg{'params'}, *cellparams_name,
1659      *cellparams_type, *cellparams_rule);
1660
1661    # Build the result
1662    @text = (&'SdfJoin("__cell", '', %param));
1663
1664    # Return result
1665    return @text;
1666}
1667
1668# endtable - end a table
1669@_endtable_MacroArgs = ();
1670sub endtable_Macro {
1671    local(%arg) = @_;
1672    local(@text);
1673
1674    # Check the state
1675    unless (@'sdf_tbl_state) {
1676        &'AppMsg("error", "!endtable not expected");
1677        return ();
1678    }
1679
1680    # Update the state
1681    pop(@'sdf_tbl_state);
1682    pop(@'sdf_tbl_start);
1683
1684    # Build the result
1685    @text = (&'SdfJoin("__endtable", ''));
1686
1687    # Return result
1688    return @text;
1689}
1690
1691##### Header/footer Macros #####
1692
1693# build_header - build a header macro
1694@_build_header_MacroArgs = (
1695    'Name       Type        Default     Rule',
1696    'pages      string',
1697    'component  string      _NULL_',
1698    'parts      rest        _NULL_',
1699);
1700sub build_header_Macro {
1701    local(%arg) = @_;
1702#   local(@text);
1703    local(@pages, %parts);
1704
1705    # Get the arguments
1706    @pages = split(/,/, $arg{'pages'});
1707    %parts = &'SdfAttrSplit($arg{'parts'});
1708
1709    # Return result
1710    return &_PageHF('HEADER', 1, $arg{'component'}, *pages, *parts);
1711}
1712
1713# build_footer - build a footer macro
1714@_build_footer_MacroArgs = (
1715    'Name       Type        Default     Rule',
1716    'pages      string',
1717    'component  string      _NULL_',
1718    'parts      rest        _NULL_',
1719);
1720sub build_footer_Macro {
1721    local(%arg) = @_;
1722#   local(@text);
1723    local(@pages, %parts);
1724
1725    # Get the arguments
1726    @pages = split(/,/, $arg{'pages'});
1727    %parts = &'SdfAttrSplit($arg{'parts'});
1728
1729    # Return result
1730    return &_PageHF('FOOTER', 1, $arg{'component'}, *pages, *parts);
1731}
1732
1733# edit_header - edit a header macro
1734@_edit_header_MacroArgs = (
1735    'Name       Type        Default     Rule',
1736    'pages      string',
1737    'component  string      _NULL_',
1738    'parts      rest        _NULL_',
1739);
1740sub edit_header_Macro {
1741    local(%arg) = @_;
1742#   local(@text);
1743    local(@pages, %parts);
1744
1745    # Get the arguments
1746    @pages = split(/,/, $arg{'pages'});
1747    %parts = &'SdfAttrSplit($arg{'parts'});
1748
1749    # Return result
1750    return &_PageHF('HEADER', 0, $arg{'component'}, *pages, *parts);
1751}
1752
1753# edit_footer - edit a footer macro
1754@_edit_footer_MacroArgs = (
1755    'Name       Type        Default     Rule',
1756    'pages      string',
1757    'component  string      _NULL_',
1758    'parts      rest        _NULL_',
1759);
1760sub edit_footer_Macro {
1761    local(%arg) = @_;
1762#   local(@text);
1763    local(@pages, %parts);
1764
1765    # Get the arguments
1766    @pages = split(/,/, $arg{'pages'});
1767    %parts = &'SdfAttrSplit($arg{'parts'});
1768
1769    # Return result
1770    return &_PageHF('FOOTER', 0, $arg{'component'}, *pages, *parts);
1771}
1772
1773
1774##### Extraction Macros #####
1775
1776# getdoc - get (SDF) documentation from a file
1777@_getdoc_MacroArgs = @_include_MacroArgs;
1778sub getdoc_Macro {
1779    local(%arg) = @_;
1780    local(@text);
1781
1782    # Return result
1783    return &CommandMacro("sdfget -r -g", %arg);
1784}
1785
1786# getcode - get source code (i.e. non-documentation) from a file
1787@_getcode_MacroArgs = @_include_MacroArgs;
1788sub getcode_Macro {
1789    local(%arg) = @_;
1790    local(@text);
1791
1792    # Return result
1793    return &CommandMacro("sdfget -i -g", %arg);
1794}
1795
1796# getusage - get the Command Line Interface for a script
1797@_getusage_MacroArgs = (
1798    'Name       Type        Default     Rule',
1799    'command    string',
1800    'filter     filter      _NULL_',
1801    'params     rest        _NULL_',
1802);
1803sub getusage_Macro {
1804    local(%arg) = @_;
1805    local(@text);
1806
1807    # Execute the command
1808    my $command = $arg{'command'};
1809    unless (&FileFetch(*text, "sdfcli $command|")) {
1810        &'AppMsg("warning", "unable to execute sdfcli on '$command'");
1811        return ();
1812    }
1813
1814    # Filter the text
1815    &ExecFilter($arg{'filter'}, *text, $arg{'params'});
1816
1817    # Return result
1818    return ("!_bof_ 'sdfcli $command'", @text, "!_eof_");
1819}
1820
1821# perlapi - get the Application Programming Interface for a Perl library
1822@_perlapi_MacroArgs = @_include_MacroArgs;
1823sub perlapi_Macro {
1824    local(%arg) = @_;
1825    local(@text);
1826
1827    # Return result
1828    return &CommandMacro('sdfapi -j', %arg);
1829}
1830
1831##### Event Processing Macros #####
1832
1833# on - specify processing for an event
1834@_on_MacroArgs = (
1835    'Name       Type        Default     Rule',
1836    'type       symbol                  <paragraph|phrase|macro|filter|table>',
1837    'mask       string',
1838    'id         eventid     _NULL_      <\w+>',
1839    'code       rest',
1840);
1841sub on_Macro {
1842    local(%arg) = @_;
1843    local(@text);
1844    local($type);
1845
1846    # Store the event
1847    $type = $arg{'type'};
1848    if ($type eq 'paragraph') {
1849        push(@evcode_paragraph, $arg{'code'});
1850        push(@evmask_paragraph, $arg{'mask'});
1851        push(@evid_paragraph, $arg{'id'});
1852    }
1853    elsif ($type eq 'phrase') {
1854        push(@evcode_phrase, $arg{'code'});
1855        push(@evmask_phrase, $arg{'mask'});
1856        push(@evid_phrase, $arg{'id'});
1857    }
1858    elsif ($type eq 'macro') {
1859        push(@evcode_macro, $arg{'code'});
1860        push(@evmask_macro, $arg{'mask'});
1861        push(@evid_macro, $arg{'id'});
1862    }
1863    elsif ($type eq 'filter') {
1864        push(@evcode_filter, $arg{'code'});
1865        push(@evmask_filter, $arg{'mask'});
1866        push(@evid_filter, $arg{'id'});
1867    }
1868    elsif ($type eq 'table') {
1869        push(@evcode_table, $arg{'code'});
1870        push(@evmask_table, $arg{'mask'});
1871        push(@evid_table, $arg{'id'});
1872    }
1873
1874    # Return result
1875    return ();
1876}
1877
1878# off - begin conditional text
1879@_off_MacroArgs = (
1880    'Name       Type        Default     Rule',
1881    'type       symbol                  <paragraph|phrase|macro|filter|table>',
1882    'id         eventid                 <\w+>',
1883);
1884sub off_Macro {
1885    local(%arg) = @_;
1886    local(@text);
1887    local($type, $id, $num);
1888
1889    # Find & delete the event, if any
1890    $type = $arg{'type'};
1891    $id = $arg{'id'};
1892    if ($type eq 'paragraph') {
1893        $num = &_EventFind(*evid_paragraph, $id);
1894        if ($num != -1) {
1895            $evcode_paragraph[$num] = '';
1896            $evid_paragraph[$num] = '';
1897        }
1898    }
1899    elsif ($type eq 'phrase') {
1900        $num = &_EventFind(*evid_phrase, $id);
1901        if ($num != -1) {
1902            $evcode_phrase[$num] = '';
1903            $evid_phrase[$num] = '';
1904        }
1905    }
1906    elsif ($type eq 'macro') {
1907        $num = &_EventFind(*evid_macro, $id);
1908        if ($num != -1) {
1909            $evcode_macro[$num] = '';
1910            $evid_macro[$num] = '';
1911        }
1912    }
1913    elsif ($type eq 'filter') {
1914        $num = &_EventFind(*evid_filter, $id);
1915        if ($num != -1) {
1916            $evcode_filter[$num] = '';
1917            $evid_filter[$num] = '';
1918        }
1919    }
1920    elsif ($type eq 'table') {
1921        $num = &_EventFind(*evid_table, $id);
1922        if ($num != -1) {
1923            $evcode_table[$num] = '';
1924            $evid_table[$num] = '';
1925        }
1926    }
1927
1928    # Check the event exists
1929    if ($num == -1) {
1930        &'AppMsg("warning", "unknown event '$id'");
1931    }
1932
1933    # Return result
1934    return ();
1935}
1936
1937##### Miscellaneous Macros #####
1938
1939# insert - insert the output from a macro
1940@_insert_MacroArgs = (
1941    'Name       Type        Default     Rule',
1942    'macro      string',
1943    'missing    string      ok          <ok|error|warning>',
1944);
1945sub insert_Macro {
1946    local(%arg) = @_;
1947    local(@text);
1948    local($name, $args);
1949
1950    # Return result
1951    ($name, $args) = split(/\s+/, $arg{'macro'}, 2);
1952    return &ExecMacro($name, $args, $arg{'missing'});
1953}
1954
1955# output - change the output file
1956@_output_MacroArgs = (
1957    'Name       Type        Default     Rule',
1958    'outfile    string',
1959);
1960sub output_Macro {
1961    local(%arg) = @_;
1962    local(@text);
1963
1964    # Return result
1965    return ("__output[]" . $arg{'outfile'});
1966}
1967
1968# message - output a message during execution
1969@_message_MacroArgs = (
1970    'Name       Type        Default     Rule',
1971    'text       string',
1972    'type       string      Object      <Object|Warning|Error|warning|error>',
1973);
1974sub message_Macro {
1975    local(%arg) = @_;
1976    local(@text);
1977    local($type);
1978
1979    # Output the message
1980    $type = "\L$arg{'type'}";
1981    &'AppMsg($type, $arg{'text'});
1982
1983    # Return result
1984    return ();
1985}
1986
1987# line - change message parameters
1988@_line_MacroArgs = (
1989    'Name       Type        Default     Rule',
1990    'lineno     integer',
1991    'filename   string      _NULL_',
1992    'context    string      line',
1993);
1994sub line_Macro {
1995    local(%arg) = @_;
1996    local(@text);
1997
1998    # Update the message variables
1999    $'app_lineno = $arg{'lineno'};
2000    $'app_context = $arg{'context'};
2001    $'app_context .= " " unless $'app_context =~ / $/;
2002    if ($arg{'filename'} ne '') {
2003        $'ARGV = $arg{'filename'};
2004        $var{'FILE_PATH'} = &'NameAbsolute($'ARGV);
2005        @var{'FILE_DIR', 'FILE_BASE', 'FILE_EXT', 'FILE_SHORT'} =
2006          &'NameSplit($var{'FILE_PATH'});
2007
2008        # Update the file and document modified times. Note that
2009        # we use a constant (1e9 = 09-Sep-2001) during regression
2010        # testing to minimise file differences.
2011        $var{'FILE_MODIFIED'} = $var{'SDF_TEST'} ? 1e9 : (stat($'ARGV))[9];
2012        $var{'DOC_MODIFIED'} = $var{'FILE_MODIFIED'} if
2013          $var{'DOC_MODIFIED'} < $var{'FILE_MODIFIED'};
2014
2015        # For the first file, set the document wide values
2016        if (!defined $var{'DOC_BASE'}) {
2017            $var{'DOC_PATH'}  = $var{'FILE_PATH'};
2018            $var{'DOC_DIR'}   = $var{'FILE_DIR'};
2019            $var{'DOC_BASE'}  = $var{'FILE_BASE'};
2020            $var{'DOC_EXT'}   = $var{'FILE_EXT'};
2021            $var{'DOC_SHORT'} = $var{'FILE_SHORT'};
2022        }
2023    }
2024
2025    # Return result
2026    return ();
2027}
2028
2029# macro_interface - build the interface section for an SDF macro
2030@_macro_interface_MacroArgs = (
2031    'Name       Type        Default     Rule',
2032    'name       string',
2033    'sep_reqd   string      _NULL_',
2034);
2035sub macro_interface_Macro {
2036    local(%arg) = @_;
2037    local(@text);
2038    local($name, @arg_list);
2039    local($format, @rules);
2040    local(@flds, $rec, %values);
2041    local($sep_reqd, $sep, $arg, $type);
2042
2043    # Build usage
2044    $name = $arg{'name'};
2045    @text = ("The general syntax is:",
2046             "E:  !{{2:$name}}");
2047
2048    # Add the arguments, if any
2049    @arg_list = eval "\@_${name}_MacroArgs";
2050    if (@arg_list) {
2051        push(@text,
2052             "",
2053             "The arguments are:",
2054             "",
2055             "!block table; format='16,16,20,48'",
2056             @arg_list,
2057             "!endblock"
2058        );
2059
2060        # Update the usage
2061        ($format, @rules) = &'TableParse(@arg_list);
2062        @flds = &'TableFields($format);
2063        $sep = '';
2064        $sep_reqd = $arg{'sep_reqd'};
2065        for $rec (@rules) {
2066            %values = &'TableRecSplit(*flds, $rec);
2067            $arg = $values{'Name'};
2068            if ($sep_reqd eq $arg) {
2069                $arg = "$sep [$arg]";
2070            }
2071            else {
2072                $arg = "$sep $arg" if $sep;
2073                $arg = "[$arg]" if $values{'Default'} ne '';
2074            }
2075            $text[1] .= " $arg";
2076
2077            # Get the separator for the NEXT argument
2078            $type = $values{'Type'};
2079            $sep = ($type =~ /^symbol$|^rest$/) ? '' : ';';
2080        }
2081    }
2082
2083    # Add the help text, if any
2084    unshift(@text, "!insert 'MACRO_INTERFACE_BEGIN'");
2085    push(@text,    "!insert 'MACRO_INTERFACE_END'");
2086
2087    # Return result
2088    return @text;
2089}
2090
2091# filter_interface - build the interface section for an SDF filter
2092@_filter_interface_MacroArgs = (
2093    'Name       Type        Default     Rule',
2094    'name       string',
2095);
2096sub filter_interface_Macro {
2097    local(%arg) = @_;
2098    local(@text);
2099    local($name, @params, @fields);
2100
2101    # Build usage
2102    $name = $arg{'name'};
2103    @text = (
2104            "The general syntax is:",
2105            "E:  !block {{2:$name}}",
2106            "E:  ...",
2107            "E:  !endblock");
2108
2109    # Add the parameters, if any
2110    @params = eval "\@_${name}_FilterParams";
2111    if (@params) {
2112        $text[1] .= "[; parameters]";
2113        if ($params[0] ne 'ANY') {
2114            push(@text,
2115                "",
2116                "The parameters are:",
2117                "",
2118                "!block table",
2119                @params,
2120                "!endblock"
2121            );
2122        }
2123    }
2124
2125    # Add the fields, if any
2126    @fields = eval "\@_${name}_FilterModel";
2127    if (@fields) {
2128        $text[2] =~ s/\.\.\./{{table}}/;
2129        push(@text,
2130             "",
2131             "The table fields are:",
2132             "",
2133             "!block table",
2134             @fields,
2135             "!endblock"
2136        );
2137    }
2138
2139    # Add the help text, if any
2140    unshift(@text, "!insert 'FILTER_INTERFACE_BEGIN'");
2141    push(@text,    "!insert 'FILTER_INTERFACE_END'");
2142
2143    # Return result
2144    return @text;
2145}
2146
2147# class - build the interface section for an SDF class
2148@_class_interface_MacroArgs = (
2149    'Name       Type        Default     Rule',
2150    'name       string',
2151);
2152sub class_interface_Macro {
2153    local(%arg) = @_;
2154    local(@text);
2155    local($name, @fields);
2156
2157    # Build usage
2158    $name = $arg{'name'};
2159    @text = (
2160            "The general syntax is:",
2161            "E:  !block {{2:$name}}[; parameters]",
2162            "E:  table of objects",
2163            "E:  !endblock");
2164
2165    # Add the fields, if any
2166    @fields = eval "\@_${name}_FilterModel";
2167    if (@fields) {
2168        push(@text,
2169             "",
2170             "The object attributes are:",
2171             "",
2172             "!block table",
2173             &'TableFormat(*fields),
2174             "!endblock"
2175        );
2176    }
2177
2178    # Add the help text, if any
2179    unshift(@text, "!insert 'CLASS_INTERFACE_BEGIN'");
2180    push(@text,    "!insert 'CLASS_INTERFACE_END'");
2181
2182    # Return result
2183    return @text;
2184}
2185
2186##### Internal Macros #####
2187
2188# _bof_ - beginning of file processing
2189@__bof__MacroArgs = (
2190    'Name       Type        Default     Rule',
2191    'filename   string      _NULL_',
2192);
2193sub _bof__Macro {
2194    local(%arg) = @_;
2195    local(@text);
2196    local($new_file);
2197
2198    # Push the state stack
2199    push(@_file_info, join("\000", $'ARGV, $'app_lineno, $'app_context,
2200      scalar(@'sdf_if_now), scalar(@'sdf_tbl_state)));
2201
2202    # Update the message state
2203    $new_file = $arg{'filename'};
2204    if ($new_file ne '') {
2205        @text = ("!line 0; '$new_file'");
2206    }
2207
2208    # Return result
2209    return (@text);
2210}
2211
2212# _eof_ - end of file processing
2213@__eof__MacroArgs = ();
2214sub _eof__Macro {
2215    local(%arg) = @_;
2216    local(@text);
2217    local($old_file, $old_line, $if_level, $tbl_level);
2218    local($start);
2219    local($missing, $last_index);
2220
2221    # Pop the state stack
2222    ($old_file, $old_line, $old_context, $if_level, $tbl_level) =
2223      split(/\000/, pop(@_file_info));
2224
2225    # Adjust the line number & set the context for messages
2226    $'app_lineno--;
2227    $'app_context = "EOF at ";
2228
2229    # Check not in a block or macro
2230    if ($'sdf_block_type ne '') {
2231        $start = $'sdf_block_start;
2232        &'AppMsg("error", "!end$'sdf_block_type missing for !$'sdf_block_type on line $start");
2233
2234        # restore the state to something safe
2235        $'sdf_block_type = '';
2236    }
2237
2238    # Check if nesting level is ok
2239    $missing = scalar(@'sdf_if_now) - $if_level;
2240    if ($missing != 0) {
2241        $start = $'sdf_if_start[$#main'sdf_if_start];
2242        &'AppMsg("error", "!endif missing for !if on line $start");
2243
2244        # pop unexpected ones so that things resync
2245        $last_index = $if_level - 1;
2246        $#main'sdf_if_start = $last_index;
2247        $#main'sdf_if_now = $last_index;
2248        $#main'sdf_if_yet = $last_index;
2249        $#main'sdf_if_else = $last_index;
2250    }
2251
2252    # Check table nesting level is ok
2253    $missing = scalar(@'sdf_tbl_state) - $tbl_level;
2254    if ($missing != 0) {
2255        $start = $'sdf_tbl_start[$#main'sdf_tbl_start];
2256        &'AppMsg("error", "!endtable missing for !table on line $start");
2257
2258        # pop unexpected ones so that things resync
2259        $last_index = $tbl_level - 1;
2260        $#main'sdf_tbl_start = $last_index;
2261        $#main'sdf_tbl_state = $last_index;
2262    }
2263
2264    # Restore the message state
2265    @text = ("!line $old_line; '$old_file'; '$old_context'");
2266
2267    # Return result
2268    return (@text);
2269}
2270
2271# _bos_ - begin a section
2272# The performance of this routine is critical so it handles its own arguments
2273sub _bos__Macro {
2274    local($args) = @_;
2275
2276    # Update the line number and context
2277    ($'app_lineno, $'app_context) = split(/\;/, $args, 2);
2278
2279    # Update the section counter
2280    $'sdf_sections++;
2281}
2282
2283# _eos_ - end of section
2284# The performance of this routine is critical so it handles its own arguments
2285sub _eos__Macro {
2286    local($args) = @_;
2287
2288    # Update the line number and context
2289    ($'app_lineno, $'app_context) = split(/\;/, $args, 2);
2290
2291    # Update the section counter
2292    $'sdf_sections--;
2293}
2294
2295# _bor_ - beginning of report processing
2296@__bor__MacroArgs = (
2297    'Name       Type        Default     Rule',
2298    'name       symbol',
2299    'params     rest        _NULL_',
2300);
2301sub _bor__Macro {
2302    local(%arg) = @_;
2303#   local();
2304    local($name);
2305    local($rpt_file);
2306    local($begin_fn);
2307
2308    # Update the state
2309    $name = $arg{'name'};
2310    push(@'sdf_report_names, $name);
2311
2312    # Load the report
2313    $rpt_file = &FindModule(&'NameJoin('', $name, 'sdr'));
2314    if ($rpt_file) {
2315        unless (require $rpt_file) {
2316            &'AppMsg("error", "unable to load report '$rpt_file'");
2317            return ();
2318        }
2319    }
2320    else {
2321        &'AppMsg("error", "unable to find report '$name'");
2322        return ();
2323    }
2324
2325    # Begin the report
2326    $begin_fn = $name . "_ReportBegin";
2327    if (defined &$begin_fn) {
2328        &$begin_fn(&SdfFilterParams($name, $params));
2329    }
2330
2331    # Return result
2332    return ();
2333}
2334
2335# _eor_ - end of report processing
2336@__eor__MacroArgs = ();
2337sub _eor__Macro {
2338    local(%arg) = @_;
2339    local(@text);
2340    local($name);
2341    local($end_fn);
2342
2343    # Update the state
2344    $name = pop(@'sdf_report_names);
2345
2346    # End the report
2347    $end_fn = $name . "_ReportEnd";
2348    if (defined &$end_fn) {
2349        @text = &$end_fn();
2350    }
2351    else {
2352        &'AppMsg("warning", "unable to find report end routine '$end_fn'");
2353    }
2354
2355    # Return result
2356    return @text;
2357}
2358
2359# _store_ - store an object
2360@__store__MacroArgs = (
2361    'Name       Type        Default     Rule',
2362    'object     rest',
2363);
2364sub _store__Macro {
2365    local(%arg) = @_;
2366#   local();
2367    local($args);
2368    local($class, $cited, $name_fld, $name, $long_fld, $long, %values);
2369    local($cite);
2370    local($prop, @properties);
2371
2372    # Get the arguments. Note that Perl 5.004 explicitly warns about
2373    # an odd number of elements in a hash list, so we need to explicitly
2374    # check for this and work around it. :-(
2375    $args = $arg{'object'};
2376    ($class, $cited, $name_fld, $name, $long_fld, $long, %values) =
2377      $args =~ /\000$/ ?
2378      (split(/\000/, $args), '') :
2379      split(/\000/, $args);
2380
2381    # Add the name to the catalog for the class, if not already done
2382    $_class{$class,'catalog'} .= "$name\n" unless $obj_name{$class,$name};
2383
2384    # Mark the object as cited, if requested
2385    if ($cited && ! $obj_name{$class, $name, 'Cite'}) {
2386        $_class{$class,'cited'} .= "$name\n";
2387        $cite = ++$_class{$class,'cite_count'};
2388        $values{'Cite'} = "[$cite]";
2389    }
2390
2391    # Store the name(s)
2392    $obj_name{$class,$name}           = 1;
2393    $obj_name{$class,$name,$long_fld} = $long;
2394    $obj_long{$class,$long}           = 1;
2395    $obj_long{$class,$long,$name_fld} = $name;
2396
2397    # Store the properties, if any
2398    @properties = split(/,/, $_class{$class,'properties'});
2399    push(@properties, 'Cite') if $cited;
2400    for $prop (@properties) {
2401        if ($values{$prop} ne '') {
2402            $obj_name{$class,$name,$prop} = $values{$prop};
2403#printf STDERR "%s=%s<\n", "$class.$name.$prop", $values{$prop};
2404            $obj_long{$class,$long,$prop} = $values{$prop};
2405        }
2406    }
2407}
2408
2409# _load_look_ - load the look library
2410@__load_look__MacroArgs = ();
2411sub _load_look__Macro {
2412    local(%arg) = @_;
2413    local(@text);
2414    local($look);
2415    local($style);
2416
2417    # Get the look and style
2418    $look = $var{'OPT_LOOK'};
2419    $style = $var{'OPT_STYLE'};
2420
2421    # Support old style names to improve backwards compatibility
2422    if ($look eq 'plain') {
2423        $look = 'simple';
2424        $var{'OPT_LOOK'} = $look;
2425    }
2426    if ($style eq 'newsletter') {
2427        $style = 'newslttr';
2428        $var{'OPT_STYLE'} = $style;
2429    }
2430
2431    # If paged output is being generated:
2432    # * Init the page size,
2433    # * load the look library,
2434    # * load the style module, and
2435    # * calculate the layout variables.
2436    @text = ();
2437    if ($var{'DOC_PAGED'}) {
2438        push(@text,
2439            "!_init_page_size_",
2440            "!inherit 'look/$look'",
2441            "!use '$style.sds'",
2442            "!_calc_layout_vars_");
2443    }
2444
2445    # Return result
2446    return @text;
2447}
2448
2449# _init_page_size - initialise the page width and height
2450@_init_page_size__MacroArgs = ();
2451sub _init_page_size__Macro {
2452#   local(%arg) = @_;
2453#   local(@text);
2454    local($page_size, $page_width, $page_height);
2455
2456    $page_size = $'sdf_pagesize{$var{'OPT_PAGE_SIZE'}};
2457    if ($page_size ne '') {
2458        ($page_width, $page_height) = split(/\000/, $page_size, 2);
2459    }
2460    else {
2461        # Custom size
2462        ($page_width, $page_height) = split(/x/, $var{'OPT_PAGE_SIZE'}, 2);
2463    }
2464    $page_width = &'SdfPoints($page_width);
2465    $page_height = &'SdfPoints($page_height);
2466    $var{'DOC_PAGE_WIDTH'} = $page_width;
2467    $var{'DOC_PAGE_HEIGHT'} = $page_height;
2468
2469    # Return result
2470    return ();
2471}
2472
2473# _calc_layout_vars_ - calculate the layout information variables
2474@__calc_layout_vars__MacroArgs = ();
2475sub _calc_layout_vars__Macro {
2476#   local(%arg) = @_;
2477#   local(@text);
2478    local($h_top, $h_height, $f_height, $f_top, $m_top, $m_height);
2479    local($full_width, $text_width, $columns, $col_width);
2480
2481    # Calculate the height information
2482    $h_top    = &'SdfVarPoints("OPT_MARGIN_TOP");
2483    $h_height = &'SdfPageInfo("RIGHT", "HEADER_HEIGHT", "pt");
2484    $f_height = &'SdfPageInfo("RIGHT", "FOOTER_HEIGHT", "pt");
2485    $f_top    = $var{'DOC_PAGE_HEIGHT'} - $f_height -
2486                &'SdfVarPoints("OPT_MARGIN_BOTTOM");
2487    $m_top    = $h_top + $h_height +
2488                &'SdfPageInfo("RIGHT", "HEADER_GAP", "pt");
2489    $m_height = $f_top - $m_top -
2490                &'SdfPageInfo("RIGHT", "FOOTER_GAP", "pt");
2491
2492    # Initialise the number of columns
2493    $var{'OPT_COLUMNS'} = 1 if $var{'OPT_COLUMNS'} < 1;
2494    $columns = $var{'OPT_COLUMNS'};
2495
2496    # Calculate the width information
2497    $full_width = $var{'DOC_PAGE_WIDTH'} - &'SdfVarPoints("OPT_MARGIN_OUTER") -
2498                  &'SdfVarPoints("OPT_MARGIN_INNER");
2499    $text_width = $full_width - &'SdfVarPoints("OPT_SIDEHEAD_WIDTH") -
2500                  &'SdfVarPoints("OPT_SIDEHEAD_GAP");
2501    $col_width  = ($text_width - ($columns - 1) * $var{"OPT_COLUMN_GAP"}) /
2502                  $columns;
2503
2504    # Set the variables
2505    $var{'DOC_TEXT_HEIGHT'} = $m_height;
2506    $var{'DOC_FULL_WIDTH'} = $full_width;
2507    $var{'DOC_TEXT_WIDTH'} = $text_width;
2508    $var{'DOC_COLUMN_WIDTH'} = $col_width;
2509
2510    # Return result
2511    return ();
2512}
2513
2514# _load_tuning - load the tuning for a document
2515@_load_tuning__MacroArgs = ();
2516sub _load_tuning__Macro {
2517    local(%arg) = @_;
2518    local(@text);
2519    local($name);
2520    local($target_module);
2521
2522    # Tell the output driver when we start
2523    $name = $var{'OPT_TUNING'};
2524    @text = (&'SdfJoin("__tuning", $name));
2525
2526    # Add the driver-specific stuff, if any
2527    $target_module = &FindModule(&'NameJoin('', $var{'OPT_DRIVER'}, 'sdn'));
2528    if ($target_module) {
2529        push(@text, "!include '$target_module'");
2530    }
2531
2532    # Tell the output driver when we reach the end
2533    push(@text, "__endtuning[]");
2534
2535    # Return the result
2536    return @text;
2537}
2538
2539# _load_config_ - load the configuration library
2540@_load_config__MacroArgs = ();
2541sub _load_config__Macro {
2542#   local(%arg) = @_;
2543#   local(@text);
2544    local($config);
2545
2546    $config = $var{'OPT_CONFIG'};
2547    return ($config ne '') ? ("!inherit '$config'") : ();
2548}
2549
2550# package return value
25511;
2552